Gruppe
Allgemein
Problem
Wie kann ich die Datensätze in einer Tabelle vergleichen und alle doppelten Datensätze in eine zweite Tabelle übernehmen?
StandardModule: Modul1
Sub Vergleich()
Dim wks As Worksheet
Dim iRow As Integer, iAct As Integer, iRowC As Integer
Dim iRowT As Integer, iCol As Integer, iColC As Integer
Dim bln As Boolean
Set wks = ActiveSheet
iRowC = WorksheetFunction.CountA(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 <> wks.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