Dubletten mit vertauschten Datenfeldern
12.02.2015 09:29:59
Claudius20
ich möchte vertauschte Dubletten löschen: In den Spalten F und G findet sich
je ein Vokabel-Gegensatzpaar, z.B. "heiß" und "kalt". Dieses tritt z.B. innerhalb
einer langen Liste in einem Datensatz auf und dann an einer anderen Stelle
vertauscht noch einmal, z.B. als "kalt" und "heiß". Die Dublettenbeseitigungs-
funktion ab Excel 2007 hilft hier nicht. Ich habe deshalb folgenden Makro
entwickelt, der jedoch leider nicht funktioniert (in obigem Beispiel sollen dadurch
alle Datensätze, die in den Spalten F und G vertauschte Werte wie "kalt" und "heiß"
haben, gelöscht werden (vor Einsatz des Makros wurden die normalen, nicht vertauschten
Dubletten bereits mit der bekannten Dublettenentfernungsfunktion von Excel
beseitigt):
Public Sub LoescheVertauschteDubletten()
Dim Wert1 As String
Dim Wert2 As String
Dim Rng As Range
Dim i As Long
On Error GoTo Irrtum
With ActiveWorkbook.Sheets("Zuord")
For i = 501 To 2 Step -1
If IsNull(.Cells(i, 7)) = False Then
Wert1 = .Cells(i, 7)
Else
GoTo Weiter
End If
If IsNull(.Cells(i, 6)) = False Then
Wert2 = .Cells(i, 6)
Else
GoTo Weiter
End If
Set Rng = .Range("F2:F501").Find(What:=Wert1)
' After:=.Cells(.Cells.Count), _
' LookIn:=xlValues, _
' LookAt:=xlWhole, _
' SearchOrder:=xlByRows, _
' SearchDirection:=xlNext, _
' MatchCase:=False)
Do While Not Rng Is Nothing
Application.Goto Rng, True
If .Cells(Rng.Row, ActiveCell.Column) = Wert2 Then
.Rows(i).Delete shift:=xlUp
End If
Set Rng = .Range("F2:F501").FindPrevious
Loop
Weiter:
Next i
End With
Irrtum:
MsgBox "Fehler aufgetreten"
Exit Sub
Set Rng = Nothing
End Sub