Private Sub CommandButton1_Click()
Dim wsMit As Worksheet
Dim wsOhne As Worksheet
Dim letzteZeileMit As Long
Dim letzteZeileOhne As Long
Dim i As Long
Dim valueOhne As String
Dim dictMit As Object ' Dictionary für Tabelle2 (wsMit)
Dim pfadMit As String
Dim pfadOhne As String
' Variablen für die Arbeitsmappen
Dim wbMit As Workbook
Dim wbOhne As Workbook
Dim dateiMitGeöffnet As Boolean
Dim dateiOhneGeöffnet As Boolean
' Dateipfade definieren (bitte anpassen)
pfadMit = "C:\Users\Besitzer\Desktop\ListemitA1.xlsx"
pfadOhne = "C:\Users\Besitzer\Desktop\ListeohneA1.xlsx"
' --- Quell- und Ziel-Dateien öffnen ---
On Error Resume Next
Set wbMit = Workbooks.Open(pfadMit) ' Versuche, die Quell-Datei zu öffnen
If wbMit Is Nothing Then
MsgBox "Die Datei 'ListemitA1.xlsx' konnte nicht geöffnet werden.", vbCritical
Exit Sub
End If
Set wbOhne = Workbooks.Open(pfadOhne) ' Versuche, die Ziel-Datei zu öffnen
If wbOhne Is Nothing Then
MsgBox "Die Datei 'ListeohneA1.xlsx' konnte nicht geöffnet werden.", vbCritical
wbMit.Close SaveChanges:=False
Exit Sub
End If
On Error GoTo 0 ' Fehlerbehandlung wieder ausschalten
' Setze die Arbeitsblätter
Set wsMit = wbMit.Sheets("Tabelle1") ' Tabelle1 der Quell-Datei
Set wsOhne = wbOhne.Sheets("Tabelle1") ' Tabelle1 der Ziel-Datei
' Finde die letzte verwendete Zeile in beiden Blättern (in Spalte 1 - A)
letzteZeileMit = wsMit.Cells(wsMit.Rows.Count, 1).End(xlUp).Row
letzteZeileOhne = wsOhne.Cells(wsOhne.Rows.Count, 1).End(xlUp).Row
' Initialisiere das Dictionary
Set dictMit = CreateObject("Scripting.Dictionary")
' Lade die Daten aus Spalte B von "Tabelle1" (wsMit) in das Dictionary
For i = 1 To letzteZeileMit
Dim valueMit As String
valueMit = Trim(wsMit.Cells(i, 2).Value) ' Trim entfernt überflüssige Leerzeichen
' Wenn der Wert nicht leer ist und noch nicht im Dictionary enthalten, füge ihn hinzu
If valueMit <> "" And Not dictMit.exists(valueMit) Then
dictMit.Add valueMit, wsMit.Cells(i, 1).Value ' Speichere Spalte A als Wert, Spalte B als Schlüssel
End If
Next i
' Überprüfe, ob das Dictionary korrekt befüllt wurde
If dictMit.Count = 0 Then
MsgBox "Fehler: Keine Daten in Tabelle1 der Quell-Datei gefunden oder alle Zellen in Spalte B sind leer.", vbCritical
wbMit.Close SaveChanges:=False
wbOhne.Close SaveChanges:=False
Exit Sub
End If
' Vergleiche die Daten von Tabelle1 (wsOhne) in der Ziel-Datei mit den Daten aus dem Dictionary
For i = 1 To letzteZeileOhne
valueOhne = Trim(wsOhne.Cells(i, 2).Value) ' Trim entfernt überflüssige Leerzeichen
' Prüfe, ob der Text in Tabelle1 der Ziel-Datei (wsOhne) im Dictionary vorhanden ist
If valueOhne <> "" And dictMit.exists(valueOhne) Then
' Wenn der Wert existiert, kopiere den zugehörigen Wert aus der Quell-Datei (Spalte A) nach Tabelle1 (Spalte A) in der Ziel-Datei
wsOhne.Cells(i, 1).Value = dictMit(valueOhne)
End If
Next i
' Speichern und Schließen
''' wbOhne.Close SaveChanges:=True ' Ziel-Datei speichern und schließen
wbOhne.Save
''' wbMit.Close SaveChanges:=False ' Quell-Datei schließen ohne Speichern
wbMit.Save
MsgBox "Datenvergleich und Kopiervorgang abgeschlossen.", vbInformation
End Sub
