Gruppe
Allgemein
Problem
Wie kann ich die Datensätze in zwei Tabellen vergleichen und die doppelt vorkommenden Werte in einem dritten Arbeitsblatt sammeln?
StandardModule: Modul1
Sub Vergleich()
Dim wks As Worksheet, wksSec As Worksheet
Dim iRow As Integer, iAct As Integer, iRowC As Integer
Dim iRowT As Integer, iCol As Integer, iColC As Integer
Dim iRowS As Integer
Dim bln As Boolean
Set wks = ActiveSheet
Set wksSec = Worksheets("Spieler2")
iRowC = WorksheetFunction.CountA(Columns(1))
iRowS = WorksheetFunction.CountA(wksSec.Columns(1))
iColC = WorksheetFunction.CountA(Rows(1))
iRow = 1
Worksheets.Add after:=Worksheets(Worksheets.Count)
For iRow = 1 To iRowC
For iAct = 1 To iRowC
If iRow <> iAct Then
bln = False
For iCol = 1 To iColC
If wks.Cells(iRow, iCol).Value <> wksSec.Cells(iAct, iCol).Value Then
bln = True
Exit For
End If
Next iCol
If bln = False Then
iRowT = iRowT + 1
Range(Cells(iRowT, 1), Cells(iRowT, iRowC)).Value = _
wks.Range(wks.Cells(iRow, 1), wks.Cells(iRow, iRowC)).Value
End If
End If
Next iAct
Next iRow
Columns.AutoFit
End Sub