Abgleich funktioniert nicht
07.01.2016 09:33:10
Willi
ich gleiche die Zellen zweier Spalten in zwei Tabellen ab. Von den ca. 5000 Zeilen werden einige als in Tab CSV-Datei (s.u.) nicht enthalten (in Alt-CSV) erkannt. Nach einem händischen Test stellte sich aber heraus, daß der Wert in beiden Tabellen in der entsprechenden Spalte vorkommt.
Vorgehensweise zum Verständnis:
1.) ich erstelle eine Tabelle aus diversen Quellen
2.) diese Tabelle wird als CSV Datei gespeichert
3.) diese Arbeit muß jeden Tag erfolgen, daher wird am nächsten Tag wieder eine CSV Datei erstellt und die ältere in Alt-CSV umbenannt.
4.) die ältere CSV Datei wird in eine gesonderte Tabelle einglesen
5.) nun muß abgegleichen werden, ob in Spalte 13 (M) in CSV-Datei und in Alt-CSV die Werte vorhanden sind. Beispiel: ist "CF-54C4076EG" in Spalte M in beiden Tabellen vorhanden.
Diese Abfrage erfolgt über:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Sub AAA_Diff_Vergleich()
Dim x1, y1, z1, lngZaehler As Long
Dim Zelle As Range
Dim WksU As Worksheet, WksV As Worksheet, WksW As Worksheet
Dim Kat As String, Kategorie As String
Dim c As Range
Set WksU = Worksheets("Alt-CSV")
Set WksV = Worksheets("CSV-Datei")
Set WksW = Worksheets("Differenz")
x1 = Sheets("CSV-Datei").UsedRange.SpecialCells(xlCellTypeLastCell).Row
y1 = Sheets("Alt-CSV").UsedRange.SpecialCells(xlCellTypeLastCell).Row
y1 = y1 + 1
z1 = 2
' -------------------------- Header in Differenz Tabelle kopieren
' MsgBox "Header in Differenz Tabelle kopieren"
Sheets("PS-Header").Select
Rows("1:1").Select
Selection.Copy
Sheets("Differenz").Select
Rows("1:1").Select
ActiveSheet.Paste
' -------------------------- Header in Differenz Tabelle kopieren Ende
Sheets("Alt-CSV").Select
For Each c In Range("M2:M" & x1)
c = WorksheetFunction.Trim(c)
Next
MsgBox "Trim Alt-CSV"
Sheets("CSV-Datei").Select
For Each c In Range("M2:M" & x1)
c = WorksheetFunction.Trim(c)
Next
MsgBox "Trim CSV-Datei"
' --- Herstellernummer vergleichen - CSV-Datei mit Alt-CSV vergleichen
ActiveSheet.UsedRange.EntireRow.Interior.ColorIndex = xlNone
With WksV
For lngZaehler = 2 To x1
Set Zelle = WksV.Columns(13).Find(What:=WksU.Cells(lngZaehler, 13), _ LookIn:= _
xlValues, lookat:=xlWhole)
If Not Zelle Is Nothing Then
If lngZaehler = x1 Then
' GoTo H_Alt
GoTo warten
End If
Else
Kat = Trim(Range("D" & lngZaehler))
Kategorie = Left(Kat, 7)
If Kategorie "Zubehör" Then
WksV.Rows(lngZaehler).Copy WksW.Rows(z1)
Sheets("Differenz").Select
WksW.Cells(z1, 1).Select
Selection.EntireRow.Interior.ColorIndex = 6
z1 = z1 + 1
End If
End If
Sheets("CSV-Datei").Select
Set Zelle = Nothing
ActiveSheet.UsedRange.EntireRow.Interior.ColorIndex = xlNone
Next lngZaehler
End With
warten:
End Sub
Das Problem?
Es werden 4 Zellen gefunden, deren Inhalt angeblich nicht in der Alt-CSV Tabelle enthalten ist. Wären es alle ca. 5000 hätte ich einen Fehler gemacht, aber es sind immer wieder dieselben 4 (reproduzierbar) Nummern.
Wie ihr seht, bin ich schon mit einem Trim in beiden Tabellen auf die Spalte losgegangen, aber das nutzt nichts.
Leider weiß ich nicht, ob Trim nur vorweg stehende Blanks löscht oder auch nachfolgende?! Löscht es auch andere Escape Sequenzen?
Wenn ja, sieht hier irgendjemand einen Fehler, oder hat eine andere Programmlösung.
Leider muß ich das Ganze in drei verschiedenen Variationen mit unterschiedlichen Spalten und in unterschiedlicher Richtung (neu -> alt, alt -> neu) durchlaufen, so daß zwei For Schleifen soviel Zeit in Anspruch nehmen, daß ich davon bisher abgesehen habe; aber wenn nichts anderes helfen sollte, so nehme ich auch das :(.
Leider ist es so, daß gerade dieses Ergebnis die Quintessenz der ganzen fast 2000 Zeilen Programmcode ist, die ich bisher geschrieben habe. Wenn ich da keine saubere und vor allem zuverlässige Lösung finde, war die ganze Arbeit umsonst.
So bleibt mir nur:
! ! ! ! H I L F E ! ! ! !
Danke schon mal im Voraus
Willi