Tabellenvergleich aus zwei Dateien
19.07.2003 10:06:39
Erich M.
ich habe ein Makro mit einer UserForm mit Einlesen der geöffneten Dateien. Das Makro hat das Ziel, Werte in zwei Vergleichsspalten zu vergleichen und Werte zu finden, die nicht übereinstimmen. Wenn gefunden erfolgt eine Kopie in eine neu erstellte Tabelle "Fehlende".
Soweit funktioniert das ganze, wenn die Vergleichsspalten sich in der gleichen Datei befinden.
Leider finde ich keine Lösung, wenn zwei Vergleichsspalten in unterschiedlichen Dateien verglichen werden, da dann das "Auslesen" der Daten nicht funktioniert.
Nachstehend der Code, der aus UserForm gestartet wird, wenn über die UserForm festgelegt wurde, welche Spalten verglichen werden sollen.
Damit man sich ein besseres Bild über die UserForm machen kann, habe ich die Datei ebenfalls hochgeladen - über die Menueleiste mit Button "Vergleich" kann die userForm aktiviert werden.
Private Sub CommandButton3_Click()
Dim verg1(3000), verg2(3000), merk1(3000), merk2(3000) ' Feldvariablen dimensionieren
Dim Workbooks As String
Dim myName1 As String, myName2 As String, myName3 As String
Dim Spalte1 As Integer, Spalte2 As Integer, Spalte3 As Integer, Spalte4 As Integer
Dim z As Integer, y As Integer, r As Integer, s As Integer, t As Integer
Dim tt As Integer, v As Integer, vv As Integer
TabAuswahl
myName1 = ComboBox1.Text '"Erste Datei"
myName2 = ComboBox10.Text '"Zweite Datei"
Spalte1 = ComboBox12.Text '"Vergleichsspalte"
Spalte2 = ComboBox13.Text '"Vergleichsspalte"
' Werte aus Tabelle 1 einlesen
'Workbooks(Combox1.Text).Activate
Sheets(ComboBox9.Text).Activate ' 1. Tabelle aktivieren
'Spalte1.Select
z = 1 ' Schleifenzähler auf Startwert (Zeile 1)
Do While Cells(z, Spalte1) <> "" ' Start der Schleife zum Einlesen der Werte
verg1(z) = Cells(z, Spalte1) ' Vergleichswert einlesen
z = z + 1 ' Schleifenzähler um 1 erhöhen
Loop ' Wendepunkt für Schleife
' Werte aus Tabelle 2 einlesen
Sheets(ComboBox11.Text).Activate ' Tabelle 2 aktivieren
'Spalte2.Select
y = 1 ' Wie oben
Do While Cells(y, Spalte2) <> "" ' "
verg2(y) = Cells(y, Spalte2) ' "
y = y + 1 ' "
Loop ' "
' Werte vergleichen
For r = 1 To z - 1 ' Start "äußere" For To Next Schleife
For s = 1 To y - 1 ' Start "innere" For To Next Schleife
' Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja" ' Wenn Vergleichswerte gleich, Merker setzen
If verg2(s) = verg1(r) Then merk2(s) = "ja" ' Wenn Vergleichswerte gleich, Merker setzen
Next s ' Wendepunkt "innere" For To Next Schleife
Next r ' Wendepunkt "äußere" For To Next Schleife
Sheets.Add.Name = "Fehlende"
Worksheets("Fehlende").Activate ' Tabelle 3 aktivieren
' Ungleiche Werte aus Tabelle 1 ausgeben
Cells(1, 1) = "Wert fehlt in" & Chr(10) & "Datei " & myName2 _
& Chr(10) & "Tabelle" & ComboBox11.Text & Chr(10) & "Spalte " & Spalte2
For t = 1 To r ' Start For To Next Schleife
If merk1(t) <> "ja" Then ' Wenn Merker = "ja" dann
tt = tt + 1 ' > Zeilenzähler um 1 erhöhen
Cells(tt + 1, 1) = verg1(t) ' > Vergleichswert in Tabelle schreiben
End If ' Ende Wenn-Bedingung
Next t ' Wendepunkt For To Next Schleife
' Ungleiche Werte aus Tabelle 2 ausgeben
Cells(1, 2) = "Wert fehlt in" & Chr(10) & "Datei " & myName1 _
& Chr(10) & "Tabelle" & ComboBox9.Text & Chr(10) & "Spalte " & Spalte1
For v = 1 To s ' wie oben
If merk2(v) <> "ja" Then ' "
vv = vv + 1 ' "
Cells(vv + 1, 2) = verg2(v) ' "
End If ' "
Next v ' "
Sheets("Fehlende").Activate
Range("B2").Select
ActiveWindow.FreezePanes = True
Range("C1").Select
Unload Me
End Sub
Die Datei https://www.herber.de/bbs/user/287.xls wurde aus Datenschutzgründen gelöscht
Vielen Dank für Vorschläge!mfg
Erich