Spaltenvergleich besser programmieren
19.01.2016 08:34:49
Willi
hier komme ich mal mit einem funktionierenden Modul. Da ich damit zwei Spalten zweier Tabellen gegeneinander vergleiche, dauert das bei ca. 36.000 Vergleichen eine gefühlte Ewigkeit.
Der Ablauf ist folgender:
1.) Jede Zelle aus Spalte M (CSV-Datei) wird mit allen Zellen in Spalte M (Alt-CSV)verglichen
2.) ist der Inhalt von CSV-Datei.M nicht in Alt-CSV.M dann wird die Zeile (nicht Zelle!) nach Tabelle Neu geschrieben
Sub Diff_Vergleich()
Dim i As Long, k As Long, lngZaehler As Long, z1 As Long
Dim wksU As Worksheet, wksV As Worksheet, wksH As Worksheet, wksM As Worksheet
Set wksU = Worksheets("Alt-CSV")
Set wksV = Worksheets("CSV-Datei")
Set wksH = Worksheets("NEU")
Set wksM = Worksheets("Alt")
x1 = Worksheets("CSV-Datei").UsedRange.SpecialCells(xlCellTypeLastCell).Row
y1 = Worksheets("Alt-CSV").UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To x1
For k = 2 To y1
If wksV.Cells(i, 13) = wksU.Cells(k, 13) Then
GoTo Weiter_i
Else
If wksU.Cells(k, 13) = "" Or i > y1 Then
wksV.Rows(i).Copy wksH.Rows(lngZaehler)
lngZaehler = lngZaehler + 1
d1 = d1 + 1
GoTo Weiter_i
End If
End If
If k = y1 And wksV.Cells(i, 13) wksU.Cells(k, 13) Then
wksV.Rows(i).Copy wksH.Rows(lngZaehler)
lngZaehler = lngZaehler + 1
d1 = d1 + 1
GoTo Weiter_i
End If
If wksV.Cells(i, 13) = "" Then
GoTo Ende
End If
Next k
k = 2
Weiter_i:
Next i
Ende:
End Sub
Leider muß ich auch den Gegenvergleich anstellen, also:1.) Jede Zelle aus Spalte M (Alt-CSV) wird mit allen Zellen in Spalte M (CSV-Datei)verglichen
2.) ist der Inhalt von Alt-CSV.M nicht in CSV-Datei.M dann wird die Zeile (nicht Zelle!) nach Tabelle Alt geschrieben.
Damit durchlaufe ich das Modul mit anderen Parametern zweimal :(
und das dauert.
Weiß jemand eine bessere vor allem aber schnellere Lösung?
Schon Vorab meinen herzlichen Dank.
Willi