Felder in 2 Tabellen abgleichen

Mahlzeit zusammen,
ich habe eine sehr schwierige Frage an die Experten im Forum an der ich schon eine ganze Weile rumrätsele aber keinen Schritt weiterkomme.
Ich habe 2 fast identische Tabellen auf 2 verschiedenen Blättern mit mehreren Spalten. Der Inhalt der meisten Spalten ist identisch, wenige unterschiedliche Spalten beeinhalten Zusatzinfos. Jede Datenzeile hat eine eindeutige Nummer (Primärschlüssel), die identisch zur vergleichbaren Zeile in der anderen Tabelle ist. Die Sortierung der beiden Tabellen kann sich unabhängig von einander ändern oder eine der Tabellen könnte gefiltert sein.
Jetzt kommen wir zum Problem: Ich möchte in der Lage sein, Daten in beiden Tabellen zu verändern und gleichzeitig das entsprechende Feld in der anderen Tabelle automatisch mitändern. Dabei sind nur die identischen Spalten von Interesse. Durch die teilweise unterschiedliche Reihenfolge der Zeilen in beiden Tabellen ist einfaches Überkopieren ganzer Spalten nicht möglich. (Habe ich bereits versucht und dabei alle Daten in beiden Tabellen durcheinandergewürfelt, war ne ganz tolle Idee!!)
Ich habe schon diverse Ansätze probiert, komme aber mit meinem beschränkten Wissen nicht zum Ziel.
Es wäre super wenn jemand eine Idee hätte die mich in die richtige Richtung führt.
Gruß
Helmar

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Helmar,
ich hab die Makros jetzt etwas angepasst, so dass weitere Spalten einfach ergänzt werden können. Für jede weitere Spalte muß du nur jeweils eine weitere Case-Anweisung einfügen.
Makros für Blatt1:


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim wks1 As Worksheet, wks2 As Worksheet, Finden As Range
Dim SpS1 As Long, SpS2 As Long, Sp As Long
Set wks1 = ThisWorkbook.Sheets("Tab1")
Set wks2 = ThisWorkbook.Sheets("Tab2")
SpS1 = 1 'Spalte mit Schlüsselsfeldern in Blatt 1
SpS2 = 1 'Spalte mit Schlüsselsfeldern in Blatt 2
Select Case Target.Column
Case 2   'Spalte in Blatt 1
Sp = 2 'ensprechende Spalte in Blatt 2
Case 3
Sp = 4
Case Else
' Do nothing
Exit Sub
End Select
Set Finden = wks2.Columns.Find(What:=wks1.Cells(Target.Row, SpS1), LookIn:=xlValues, Lookat:=xlWhole)
If Finden Is Nothing Then
If MsgBox("Schlüssel in Tabelle " & wks2.Name & " nicht vorhanden." & vbLf & vbLf _
& "Zeile in" & wks2.Name & " einfügen?", vbYesNo, "Tabellenabgleich") = vbYes Then
Call ZeilenDatenuebertragen1(wks1, wks2, Target.Row, SpS2)
End If
Else
If wks2.Cells(Finden.Row, Sp).Value <> Target.Value Then
wks2.Cells(Finden.Row, Sp).Value = Target.Value
End If
End If
End Sub
Sub ZeilenDatenuebertragen1(Blatt1 As Worksheet, Blatt2 As Worksheet, Zeile1 As Long, SpS2 As Long)
' Fügt Daten einer Zeile aus Blatt1 in Blatt2 am Ende ein
Dim Zeile2 As Long
Zeile2 = Blatt2.Cells(65000, SpS2).End(xlUp).Row + 1 'nächste leere Zeile in Blatt 2
Blatt2.Cells(Zeile2, 1).Value = Blatt1.Cells(Zeile1, 1).Value
Blatt2.Cells(Zeile2, 2).Value = Blatt1.Cells(Zeile1, 2).Value
Blatt2.Cells(Zeile2, 4).Value = Blatt1.Cells(Zeile1, 3).Value
End Sub

Makros für Blatt2:


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim wks1 As Worksheet, wks2 As Worksheet, Finden As Range
Dim SpS1 As Long, SpS2 As Long, Sp As Long
Set wks1 = ThisWorkbook.Sheets("Tab1")
Set wks2 = ThisWorkbook.Sheets("Tab2")
SpS1 = 1 'Spalte mit Schlüsselsfeldern in Blatt 1
SpS2 = 1 'Spalte mit Schlüsselsfeldern in Blatt 2
Select Case Target.Column
Case 2   'Spalte in Blatt 2
Sp = 2 'ensprechende Spalte in Blatt 1
Case 4
Sp = 3
Case Else
' Do nothing
Exit Sub
End Select
Set Finden = wks1.Columns.Find(What:=wks2.Cells(Target.Row, SpS2), LookIn:=xlValues, Lookat:=xlWhole)
If Finden Is Nothing Then
If MsgBox("Schlüssel in Tabelle " & wks1.Name & " nicht vorhanden." & vbLf & vbLf _
& "Zeile in" & wks1.Name & " einfügen?", vbYesNo, "Tabellenabgleich") = vbYes Then
Call ZeilenDatenuebertragen2(wks1, wks2, Target.Row, SpS1)
End If
Else
If wks1.Cells(Finden.Row, Sp).Value <> Target.Value Then
wks1.Cells(Finden.Row, Sp).Value = Target.Value
End If
End If
End Sub
Sub ZeilenDatenuebertragen2(Blatt1 As Worksheet, Blatt2 As Worksheet, Zeile2 As Long, SpS1 As Long)
' Fügt Daten einer Zeile aus Blatt2 in Blatt1 am Ende ein
Dim Zeile1 As Long
Zeile1 = Blatt1.Cells(65000, SpS1).End(xlUp).Row + 1 'nächste leere Zeile in Blatt 2
Blatt1.Cells(Zeile1, 1).Value = Blatt2.Cells(Zeile2, 1).Value
Blatt1.Cells(Zeile1, 2).Value = Blatt2.Cells(Zeile2, 2).Value
Blatt1.Cells(Zeile1, 3).Value = Blatt2.Cells(Zeile2, 4).Value
End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Felder in 2 Tabellen abgleichen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread