AW: Doppelte Werte entfernen
12.04.2006 07:52:30
UweD
Hallo
so dürfte es klappen...
Sub doppRaus()
Dim SP#, LC%, LR%, TB1, i#
On Error GoTo Fehler
Set TB1 = Sheets("Tabelle1")
LC = TB1.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte
For SP = 1 To LC
LR = TB1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
For i = LR To 2 Step -1 'in 1 steht z.B. Überschrift
If WorksheetFunction.CountIf(TB1.Columns(SP), TB1.Cells(i, SP)) > 1 Then
TB1.Rows(i).Delete
End If
Next
Next
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Sub
Gruß UweD
(Rückmeldung wäre schön)