Supportnet / Forum / Tabellenkalkulation
2 kpl. Tabellen vergleichen jede Änderung in eine neue einfügen
Frage
Hallo Excelspezialisten,
ich möchte mit einem Makro 2 kpl. Tabellen nach ihren Inhalten (Zahlen, Wörter) vergleichen, und bei jeder Änderung in einer Zelle oder neuen Zeile die ganze Zeile in eine neue Tabelle einfügen.
Im Forum habe schon gesucht, aber nichts vergleichbares gefunden.
Ich hoffe ihr könnt mir weiterhelfen!
Gruß
fedjo
Antwort 1 von fedjo
Hi,
habe einen Makro gefunden, das aber nur ungleiche Inhalte von Zellen in Tabelle3 kopiert, ich benötige aber die ganze dazugehörige Zeile in Tabelle3.
Vielleicht hat dazu jemand eine Lösung.
Gruß
fedjo
Option Explicit
Sub Vergleich()
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t, tt As Integer
Dim v, vv As Integer
z = 2
Do While Worksheets("Tabelle1").Cells(z, 1) <> ""
verg1(z) = Worksheets("Tabelle1").Cells(z, 1)
z = z + 1
Loop
´ Werte aus Tabelle 2 einlesen
y = 2
Do While Worksheets("Tabelle2").Cells(y, 1) <> ""
verg2(y) = Worksheets("Tabelle2").Cells(y, 1)
y = y + 1
Loop
´ Werte vergleichen
For r = 1 To z - 1
For s = 1 To y - 1
´ Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next s
Next r
´ Ungleiche Werte aus Tabelle 1 ausgeben
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle3").Cells _
(tt, 1) = verg1(t)
End If
Next t
´ Ungleiche Werte aus Tabelle 2 ausgeben
For v = 1 To s
If merk2(v) <> "ja" Then
vv = vv + 1
Worksheets("Tabelle3").Cells _
(vv + t, 1) = verg2(v)
End If
Next v
End Sub
habe einen Makro gefunden, das aber nur ungleiche Inhalte von Zellen in Tabelle3 kopiert, ich benötige aber die ganze dazugehörige Zeile in Tabelle3.
Vielleicht hat dazu jemand eine Lösung.
Gruß
fedjo
Option Explicit
Sub Vergleich()
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t, tt As Integer
Dim v, vv As Integer
z = 2
Do While Worksheets("Tabelle1").Cells(z, 1) <> ""
verg1(z) = Worksheets("Tabelle1").Cells(z, 1)
z = z + 1
Loop
´ Werte aus Tabelle 2 einlesen
y = 2
Do While Worksheets("Tabelle2").Cells(y, 1) <> ""
verg2(y) = Worksheets("Tabelle2").Cells(y, 1)
y = y + 1
Loop
´ Werte vergleichen
For r = 1 To z - 1
For s = 1 To y - 1
´ Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next s
Next r
´ Ungleiche Werte aus Tabelle 1 ausgeben
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle3").Cells _
(tt, 1) = verg1(t)
End If
Next t
´ Ungleiche Werte aus Tabelle 2 ausgeben
For v = 1 To s
If merk2(v) <> "ja" Then
vv = vv + 1
Worksheets("Tabelle3").Cells _
(vv + t, 1) = verg2(v)
End If
Next v
End Sub
Antwort 2 von juergenb
Hallo fedjo!
Habe das von Dir eingestellte Makro geändert, es kopiert nun die ganze Zeile in die dritte Tabelle.
Nur: Es vergleicht ja nur die erste Spalte miteinander!
Sollen alle Spalten verglichen werden, solltest Du eine Schleife hinzufügen!
Ciao Jürgen
Option Explicit
Sub Vergleich()
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t, tt As Integer
Dim v As Integer
z = 2
Do While Worksheets("Tabelle1").Cells(z, 1) <> ""
verg1(z) = Worksheets("Tabelle1").Cells(z, 1)
z = z + 1
Loop
´ Werte aus Tabelle 2 einlesen
y = 2
Do While Worksheets("Tabelle2").Cells(y, 1) <> ""
verg2(y) = Worksheets("Tabelle2").Cells(y, 1)
y = y + 1
Loop
´ Werte vergleichen
For r = 1 To z - 1
For s = 1 To y - 1
´ Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next s
Next r
´ Ungleiche Werte aus Tabelle 1 ausgeben
tt = 0
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle1").Rows(t).Copy
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next t
´ Ungleiche Werte aus Tabelle 2 ausgeben
For v = 1 To s
If merk2(v) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle2").Rows(v).Copy
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next v
Application.CutCopyMode = False
End Sub
Habe das von Dir eingestellte Makro geändert, es kopiert nun die ganze Zeile in die dritte Tabelle.
Nur: Es vergleicht ja nur die erste Spalte miteinander!
Sollen alle Spalten verglichen werden, solltest Du eine Schleife hinzufügen!
Ciao Jürgen
Option Explicit
Sub Vergleich()
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t, tt As Integer
Dim v As Integer
z = 2
Do While Worksheets("Tabelle1").Cells(z, 1) <> ""
verg1(z) = Worksheets("Tabelle1").Cells(z, 1)
z = z + 1
Loop
´ Werte aus Tabelle 2 einlesen
y = 2
Do While Worksheets("Tabelle2").Cells(y, 1) <> ""
verg2(y) = Worksheets("Tabelle2").Cells(y, 1)
y = y + 1
Loop
´ Werte vergleichen
For r = 1 To z - 1
For s = 1 To y - 1
´ Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next s
Next r
´ Ungleiche Werte aus Tabelle 1 ausgeben
tt = 0
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle1").Rows(t).Copy
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next t
´ Ungleiche Werte aus Tabelle 2 ausgeben
For v = 1 To s
If merk2(v) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle2").Rows(v).Copy
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next v
Application.CutCopyMode = False
End Sub
Antwort 3 von fedjo
Hallo Jürgen
Danke für die schnelle Antwort.
Ich habe den Cote getestet und eine Fehlermeldung erhalten:
Du hast recht
Es sollten aber alle Spalten verglichen werden, vielleicht kannst du die Schleife noch einfügen!
Danke
Gruß
fedjo
Danke für die schnelle Antwort.
Ich habe den Cote getestet und eine Fehlermeldung erhalten:
Zitat:
Do While Worksheets("Tabelle1").Cells(z, 1) <> ""
Do While Worksheets("Tabelle1").Cells(z, 1) <> ""
Du hast recht
Zitat:
es vergleicht ja nur die erste Spalte miteinander!
.es vergleicht ja nur die erste Spalte miteinander!
Es sollten aber alle Spalten verglichen werden, vielleicht kannst du die Schleife noch einfügen!
Danke
Gruß
fedjo
Antwort 4 von fedjo
Hallo Jürgen,
habe den Fehler gefunden:
Brauche also noch deine Hilfe bei der Schleife.
Gruß
fedjo
habe den Fehler gefunden:
Zitat:
Do While Worksheets("Tabelle1").Cells(z, 1) <> ""
ich hatte eine andere Bezeichnung für Tabelle1.Do While Worksheets("Tabelle1").Cells(z, 1) <> ""
Brauche also noch deine Hilfe bei der Schleife.
Gruß
fedjo
Antwort 5 von juergenb
Hallo fedjo,
habe dir das Makro angepasst, du musst nur die Anzahl der Spalten die verglichen werden sollen in der Sub Master eingeben.
Da es leichter war habe ich aus Vergleich eine Funktion mit Variablenübernahme gemacht.
Habe es getestet und es müsste eigentlich funktionieren.
(Hinweis: In der dritten Tabelle wird eine Leerzeile zwischen den geprüften Spalten [aus den anderen Tabellen] eingefügt)
Viel Spaß damit
Jürgen
Option Explicit
Dim tt As Integer
Sub Master()
Dim i As Integer
tt = 0
´ Hier die Anzahl der Spalten eingegben (z.B.: 3):
For i = 1 To 3
Call Vergleich(i)
Next
End Sub
Function Vergleich(akspa As Integer)
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer
Dim v As Integer
z = 2
Do While Worksheets("Tabelle1").Cells(z, akspa) <> ""
verg1(z) = Worksheets("Tabelle1").Cells(z, akspa)
z = z + 1
Loop
´ Werte aus Tabelle 2 einlesen
y = 2
Do While Worksheets("Tabelle2").Cells(y, akspa) <> ""
verg2(y) = Worksheets("Tabelle2").Cells(y, akspa)
y = y + 1
Loop
´ Werte vergleichen
r = 1
s = 1
For r = 1 To z - 1
For s = 1 To y - 1
´ Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next s
Next r
´ Ungleiche Werte aus Tabelle 1 ausgeben
t = 1
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle1").Select
Worksheets("Tabelle1").Rows(t).Copy
Worksheets("Tabelle3").Select
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next t
´ Ungleiche Werte aus Tabelle 2 ausgeben
v = 1
For v = 1 To s
If merk2(v) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle2").Select
Worksheets("Tabelle2").Rows(v).Copy
Worksheets("Tabelle3").Select
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next v
Application.CutCopyMode = False
End Function
habe dir das Makro angepasst, du musst nur die Anzahl der Spalten die verglichen werden sollen in der Sub Master eingeben.
Da es leichter war habe ich aus Vergleich eine Funktion mit Variablenübernahme gemacht.
Habe es getestet und es müsste eigentlich funktionieren.
(Hinweis: In der dritten Tabelle wird eine Leerzeile zwischen den geprüften Spalten [aus den anderen Tabellen] eingefügt)
Viel Spaß damit
Jürgen
Option Explicit
Dim tt As Integer
Sub Master()
Dim i As Integer
tt = 0
´ Hier die Anzahl der Spalten eingegben (z.B.: 3):
For i = 1 To 3
Call Vergleich(i)
Next
End Sub
Function Vergleich(akspa As Integer)
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer
Dim v As Integer
z = 2
Do While Worksheets("Tabelle1").Cells(z, akspa) <> ""
verg1(z) = Worksheets("Tabelle1").Cells(z, akspa)
z = z + 1
Loop
´ Werte aus Tabelle 2 einlesen
y = 2
Do While Worksheets("Tabelle2").Cells(y, akspa) <> ""
verg2(y) = Worksheets("Tabelle2").Cells(y, akspa)
y = y + 1
Loop
´ Werte vergleichen
r = 1
s = 1
For r = 1 To z - 1
For s = 1 To y - 1
´ Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next s
Next r
´ Ungleiche Werte aus Tabelle 1 ausgeben
t = 1
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle1").Select
Worksheets("Tabelle1").Rows(t).Copy
Worksheets("Tabelle3").Select
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next t
´ Ungleiche Werte aus Tabelle 2 ausgeben
v = 1
For v = 1 To s
If merk2(v) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle2").Select
Worksheets("Tabelle2").Rows(v).Copy
Worksheets("Tabelle3").Select
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next v
Application.CutCopyMode = False
End Function
Antwort 6 von fedjo
Hallo Jürgen,
das Makro funktioniert super!
Vielleicht könntest du mir
Eine bitte hätte ich noch, das Makro so zu verändern, das nur die Ungleichen Werte aus Tabell2 (gegenüber Tabell1) in Tabelle3 geschrieben werden.
Gruß
fedjo
das Makro funktioniert super!
Vielleicht könntest du mir
Zitat:
hier die Anzahl der Spalten eingeben (z.B.: 3):
wie und wo ich sie eingeben soll genauer erklären.hier die Anzahl der Spalten eingeben (z.B.: 3):
Eine bitte hätte ich noch, das Makro so zu verändern, das nur die Ungleichen Werte aus Tabell2 (gegenüber Tabell1) in Tabelle3 geschrieben werden.
Gruß
fedjo
Antwort 7 von juergenb
Hallo fedjo!
Bei For i = 1 To 3
musst du nach To (hier 3)
die Anzahl der Spalten eingeben.
Mit 3 werden die Spalten A, B und C
geprüft.
Mit z.B. 6 werden A, B, C, D, E und F
geprüft
usw....
Habe es nun so geändert, dass bei Ungleichheit die betreffenden Werte nur aus der Tabelle2 in die Tabelle3 kopiert werden.
Sollten aber in einer Zeile mehrere Ungleichheiten (zwischen Tabelle1 und Tabelle2) sein, wird diese Zeile jedesmal in die Tabelle3 kopiert.
Hoffe es passt.
Bei weiteren Problemen kann ich aber erst wieder ab Montag (habe jetzt gleich Feierabend und fahre übers Wochenende in den Urlaub) helfen.
Ich gebe Dir den Tipp wenn Du in VBA interressiert bist, mal ein Buch darüber zu lesen. So bin ich dazu gekommen. ;-)
Ciao Jürgen
Option Explicit
Dim tt As Integer
Sub Master()
Dim i As Integer
tt = 0
´ Hier die Anzahl der Spalten eingegben (z.B.: 3):
For i = 1 To 3
Call Vergleich(i)
Next
End Sub
Function Vergleich(akspa As Integer)
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer
Dim v As Integer
z = 2
Do While Worksheets("Tabelle1").Cells(z, akspa) <> ""
verg1(z) = Worksheets("Tabelle1").Cells(z, akspa)
z = z + 1
Loop
´ Werte aus Tabelle 2 einlesen
y = 2
Do While Worksheets("Tabelle2").Cells(y, akspa) <> ""
verg2(y) = Worksheets("Tabelle2").Cells(y, akspa)
y = y + 1
Loop
´ Werte vergleichen
r = 1
s = 1
For r = 1 To z - 1
For s = 1 To y - 1
´ Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next s
Next r
´ Ungleiche Werte aus Tabelle 1 ausgeben
t = 1
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle2").Select
Worksheets("Tabelle2").Rows(t).Copy
Worksheets("Tabelle3").Select
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next t
´ Ungleiche Werte aus Tabelle 2 ausgeben
v = 1
For v = 1 To s
If merk2(v) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle2").Select
Worksheets("Tabelle2").Rows(v).Copy
Worksheets("Tabelle3").Select
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next v
Application.CutCopyMode = False
End Function
Bei For i = 1 To 3
musst du nach To (hier 3)
die Anzahl der Spalten eingeben.
Mit 3 werden die Spalten A, B und C
geprüft.
Mit z.B. 6 werden A, B, C, D, E und F
geprüft
usw....
Habe es nun so geändert, dass bei Ungleichheit die betreffenden Werte nur aus der Tabelle2 in die Tabelle3 kopiert werden.
Sollten aber in einer Zeile mehrere Ungleichheiten (zwischen Tabelle1 und Tabelle2) sein, wird diese Zeile jedesmal in die Tabelle3 kopiert.
Hoffe es passt.
Bei weiteren Problemen kann ich aber erst wieder ab Montag (habe jetzt gleich Feierabend und fahre übers Wochenende in den Urlaub) helfen.
Ich gebe Dir den Tipp wenn Du in VBA interressiert bist, mal ein Buch darüber zu lesen. So bin ich dazu gekommen. ;-)
Ciao Jürgen
Option Explicit
Dim tt As Integer
Sub Master()
Dim i As Integer
tt = 0
´ Hier die Anzahl der Spalten eingegben (z.B.: 3):
For i = 1 To 3
Call Vergleich(i)
Next
End Sub
Function Vergleich(akspa As Integer)
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer
Dim v As Integer
z = 2
Do While Worksheets("Tabelle1").Cells(z, akspa) <> ""
verg1(z) = Worksheets("Tabelle1").Cells(z, akspa)
z = z + 1
Loop
´ Werte aus Tabelle 2 einlesen
y = 2
Do While Worksheets("Tabelle2").Cells(y, akspa) <> ""
verg2(y) = Worksheets("Tabelle2").Cells(y, akspa)
y = y + 1
Loop
´ Werte vergleichen
r = 1
s = 1
For r = 1 To z - 1
For s = 1 To y - 1
´ Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
Next s
Next r
´ Ungleiche Werte aus Tabelle 1 ausgeben
t = 1
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle2").Select
Worksheets("Tabelle2").Rows(t).Copy
Worksheets("Tabelle3").Select
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next t
´ Ungleiche Werte aus Tabelle 2 ausgeben
v = 1
For v = 1 To s
If merk2(v) <> "ja" Then
tt = tt + 1
Worksheets("Tabelle2").Select
Worksheets("Tabelle2").Rows(v).Copy
Worksheets("Tabelle3").Select
Worksheets("Tabelle3").Cells _
(tt, 1).Select
ActiveSheet.Paste
End If
Next v
Application.CutCopyMode = False
End Function
Antwort 8 von fedjo
Hallo Jürgen,
Danke und ein schönes Wochenende.
Gruß
fedjo
Danke und ein schönes Wochenende.
Gruß
fedjo
Antwort 9 von fedjo
Hallo Jürgen,
nachdem in den Zeilen immer wieder mehrere ungleiche Werte enthalten sind, werden nach dem Vergleich von 5 Spalten die gleichen Zeilen natürlich öfter in die Tabelle3 kopiert.
Das Problem konnte ich durch den Spezialfilter "Keine Duplikate" lösen.:
Oder gibt es eine bessere Lösung?
Natürlich habe ich Interesse an VBA und Makros,
ein Buch (Excel 2002 programmieren) habe ich schon gelesen. Aber das Makro über den Tabellenvergleich übersteigt doch noch meine Fähigkeiten.
Gruß
fedjo
nachdem in den Zeilen immer wieder mehrere ungleiche Werte enthalten sind, werden nach dem Vergleich von 5 Spalten die gleichen Zeilen natürlich öfter in die Tabelle3 kopiert.
Das Problem konnte ich durch den Spezialfilter "Keine Duplikate" lösen.:
Zitat:
Cells.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.Cells.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Oder gibt es eine bessere Lösung?
Natürlich habe ich Interesse an VBA und Makros,
ein Buch (Excel 2002 programmieren) habe ich schon gelesen. Aber das Makro über den Tabellenvergleich übersteigt doch noch meine Fähigkeiten.
Gruß
fedjo