Supportnet Computer
Planet of Tech

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

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

Antwort 3 von fedjo

Hallo Jürgen
Danke für die schnelle Antwort.

Ich habe den Cote getestet und eine Fehlermeldung erhalten:
Zitat:
Do While Worksheets("Tabelle1").Cells(z, 1) <> ""


Du hast recht
Zitat:
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:
Zitat:
Do While Worksheets("Tabelle1").Cells(z, 1) <> ""
ich hatte eine andere Bezeichnung für Tabelle1.

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

Antwort 6 von fedjo

Hallo Jürgen,
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.

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


Antwort 8 von fedjo

Hallo Jürgen,
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.:
Zitat:
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