wie machst du denn bislang die prüfung?? ein wenig code würde die hilfe erleichtern...
michel
probier zuerst mal so:
einfach den Datenbereich markieren, Daten/Spezialfliter Haken bei Keine Duplikate OK. Nochmal Daten/Spezialfilter Haken bei an eine andere Stelle kopieren, Stelle angeben, fertig.
Gruss
Steffen D
Und zwar so:
Option Explicit
Option Base 1
Private InputRange As Range, FirstRow As Integer, LastRow As Integer, iRow As Integer
Private OneRow As Range
Private OneCell As Range
Private OneRowArr() As Variant, OneRowArrIndex As Integer
Private RowsToDeleteArr() As Variant, RowsToDeleteArrIndex As Integer
Public Sub DoppelteZeilenLoschen()
Cells.Select
Set InputRange = ActiveCell.CurrentRegion
FirstRow = InputRange.Rows(1).Row
LastRow = InputRange.Rows(1).Row + InputRange.Rows.Count - 1
RowsToDeleteArrIndex = 1
ReDim RowsToDeleteArr(RowsToDeleteArrIndex)
For Each OneRow In InputRange.Rows
OneRowArrIndex = 0
For Each OneCell In OneRow.Cells
OneRowArrIndex = OneRowArrIndex + 1
ReDim Preserve OneRowArr(OneRowArrIndex)
OneRowArr(OneRowArrIndex) = OneCell.Value
Next OneCell
RowsToDelete OneRowArr(), OneRow.Row
Next OneRow
For RowsToDeleteArrIndex = 1 To UBound(RowsToDeleteArr)
If RowsToDeleteArr(RowsToDeleteArrIndex) <> "" Then _
Rows(RowsToDeleteArr(RowsToDeleteArrIndex)).Interior.ColorIndex = 36
Next RowsToDeleteArrIndex
iRow = FirstRow
Do
If Rows(iRow).Interior.ColorIndex = 36 Then
Rows(iRow).Delete
LastRow = LastRow - 1
If Rows(iRow).Interior.ColorIndex <> 36 Then iRow = iRow + 1
Else
iRow = iRow + 1
End If
Loop While iRow <= LastRow
End Sub
Public Sub RowsToDelete(ByRef aOneRowArr() As Variant, _
ByRef ActualRowNumber As Integer)
For Each OneRow In InputRange.Rows
OneRowArrIndex = 0
For Each OneCell In OneRow.Cells
OneRowArrIndex = OneRowArrIndex + 1
If OneCell.Value <> aOneRowArr(OneRowArrIndex) Or _
OneCell.Row = ActualRowNumber Or _
IsInRowsToDeleteArr(ActualRowNumber) = True Then
GoTo NextRow
End If
Next OneCell
RowsToDeleteArrIndex = RowsToDeleteArrIndex + 1
ReDim Preserve RowsToDeleteArr(RowsToDeleteArrIndex)
RowsToDeleteArr(RowsToDeleteArrIndex) = OneRow.Row
NextRow:
Next OneRow
End Sub
Public Function IsInRowsToDeleteArr(ByRef aActualRow As Integer) As Boolean
Dim index As Integer
IsInRowsToDeleteArr = False
For index = 1 To UBound(RowsToDeleteArr)
If RowsToDeleteArr(index) = aActualRow Then
IsInRowsToDeleteArr = True
Exit Function
End If
Next index
End Function