Vergleich von zwei Tabellen
10.08.2018 11:44:14
zwei
ich möchte bei zwei Tabellen die erste Spalte vergleichen und dann die nicht doppelten Einträge in eine dritte Tabelle kopieren. Folgenden Code habe ich in einem anderen Forum gefunden. Er funktioniert auch super. Das einzige Problem ist, dass bei diesem Code das Einfügen der nicht doppelten Einträge in Tabelle Zelle1 kopiert wird. Ich hätte gerne, dass das Einfügen in der Tabelle 3 in Zelle B4 startet. Wo genau muss ich dann bei diesem Code was abändern. Ich bin VBA Anfänger und bin dankbar für jede Hilfe.
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