Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Werte auf Übereinstimmung prüfen
#1
Hallo,

ich habe folgendes Problem. Ich versuche in einer Tabelle einige Spalten auf Übereinstimmungen zu überprüfen und anschließend (bei Übereinstimmung) Werte zu kopieren. Der Code, den ich verwende, benötigt bei den vorhandenen 4000 Einträgen jedoch viel zu lange. Beiliegend (als Excel File) und unten ist ein Beispiel mit dem verwendeten Code. In der beiliegenden Excel-Datei sind lediglich ein paar Einträge zum Testen des Codes beinhaltet. Damit wird - wie oben erwähnt - die Übereinstimmung von Einträgen in einer Tabelle überprüft und bei Übereinstimmung der Einträge werden gewisse Werte der jeweiligen Zeile in die jeweils andere Zeile kopiert. 

Wer könnte mir zu diesem Code eine Alternative weitergeben, der schneller ist und bei einigen Tausend Einträgen anwendbar wäre. Eventuell lässt sich auch der angegebene Code noch beschleunigen. 

Vielen Dank für Eure Mithilfe!

Code:
Sub Beispiel()

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

Dim LoL_1 As Long
Dim LoL_2 As Long
Dim x1 As Long
Dim x2 As Long
Dim ws1 As Worksheet
Set ws1 = Worksheets("Tabelle1")
Dim ws2 As Worksheet
Set ws2 = Worksheets("Tabelle1")

    With Worksheets("Tabelle1")
        LoL_1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
        LoL_2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
        For x1 = 1 To LoL_1
        For x2 = 1 To LoL_2
            If ws2.Range("E" & x2) = ws1.Range("J" & x1) And ws2.Range("A" & x2) = ws1.Range("A" & x1) And ws2.Range("C" & x2) = ws1.Range("H" & x1) And ws2.Range("I" & x2) <> "" Then    
                ws1.Range("K" & x1) = ws2.Range("A" & x2)
                ws1.Range("L" & x1) = ws2.Range("C" & x2)
            End If
        Next
        Next
    End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
  
End Sub


Angehängte Dateien
.xlsm   Beispiel.xlsm (Größe: 23,87 KB / Downloads: 6)
Antwortento top
#2
Hallo s...,

bei 4.000 Zeilen machst du 16.000.000 Vergleiche mit 7 Werten. Du greifst also 112.000.000 mal einzeln auf Daten des Arbeitsblattes zu.

In der Anlage habe ich einmal in zwei Schriiten Verbesserungen eingebaut.

1. Nutzen von Arrays und einmaliges Lesen und Ausgeben der Daten aus und in das Arbeitsblatt. (Sub BeispielArr)
Die 16.000.000 Vergleiche Werden im Programmspeicher durgeführt.

2. Zusätzlich Einlesen der Vergleichsdaten in ein Dictionary (schnell zu durchsuchende Datenspeicherung) (Sub BeispielDict)
Anstelle von 16.000.000 Vergleichen werden 4.000 Werte ins Dictionary geschrieben und 4.000 mal jeweils zweimal im Dictionary gesucht.

Insgesamt sollte das bei 4.000 Zeilen eine zeitliche Verbesserungen um einen Faktor weit über 1.000 ergeben.


Angehängte Dateien
.xlsm   Beispiel-3.xlsm (Größe: 27,42 KB / Downloads: 4)
helmut

Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität.
Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.





Antwortento top
#3
Hallo Helmut,

vielen Dank für Deine überzeugenden Lösungsvarianten mit Geschwindigkeitsvergleich! Ich habe schon vermutet, dass mein Code in der Formulierung unnötig viel Zeit verbraucht und für meine Anwendung ungeeignet ist. Ich hätte noch folgende Fragen zu Deinen Varianten:

1. Nutzen von Arrays: 
Liste = ws2.Range("A1").Resize(LoL_2, 9).Value
Weshalb wird hier auf Spalte I verwiesen? (ich nehme an zur Abklärung, dass nur die Zellen bearbeitet werden, welche befüllt sind)

2. Einlesen der Vergleichsdaten in ein Dictionary:
Liste2 = ws2.Range("A1").Resize(LoL_2, 9).Value
Liste1 = ws1.Range("A1").Resize(LoL_1, 10).Value
Weshalb wird hier auf Spalte I und Spalte J verwiesen?

Eine weitere Frage wäre, was sich ändert, wenn die Daten auf zwei Worksheets verteilt werden. Müßte ich da lediglich die Angaben der Variablen ws1 und ws2 anpassen und die jeweiligen Spaltenangaben anpassen?
Antwortento top
#4
Hallo s...,

zu 1. und 2.
Ich übernehme nur die Daten in den Speicher, die für das Makro benötigt werden.

zu 3.
Ja, das ist richtig. Nach deinem Makro habe ich damit gerechnet. Ansonsten könnte man nur ein Array nutzen.

Achtung!
Beim Rückschreiben des Arrays "Ausgabe" werden dort die Werte eingetragen. Zwar bleiben diese in nicht bearbeiteten Zellen erhalten, aber falls dort Formeln vorhanden waren, werden sie durch die Ergebniswerte ersetzt. Aus diesem Grund (und weil es ein wenig schneller ist) habe ich die Ausgabe im 2. Beispiel auf zwei Spalten begrenzt.
helmut

Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität.
Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.





Antwortento top
#5
Hallo Helmut,

eine Frage habe ich noch zum Makro BeispielDict:

was muss ich am Code ändern, wenn ich eine Zahl mit zwei Nachkommastellen (z.B. 43,67) anstatt von Text ausgeben möchte (muss dann einfach die String Variable von "Text" geändert werden)!?
Antwortento top
#6
Hallo s...,

anstelle von

Ausgabe(x1, 2) = Text(1)

dann

If IsNumeric(Text(1)) Then
   Ausgabe(x1, 2) = CDbl(Text(1))
Else
    Ausgabe(x1, 2) = Text(1)
End If
helmut

Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität.
Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.





Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste