Moin!
Also noch ein kleiner Exkurs. Wenn das dein Datensatz ist:
Würde Duplikte löschen die Werte in der letzten Zeile leeren und die Daten darunter hochziehen. Er würde also das Paar SpalteA und SpalteB je Zeile prüfen. Egal.
Hier mal ein Code der hoffentlich das gewünschte Ergebnis bringt. Ich bin davon ausgegangen, dass die Daten sortiert sind (also die in Spalte A). WEnn nich vorher noch sortieren (könnte man in den Code einbauen, wenn nicht sortiert werden darf, wird der Code komplizierter). Wenn in A die selbe Zahl kommt und in dem Bereich in B auch der Wert doppelt ist, wird in B der Wert gelöscht. Wie immer erstmal an einem Musterdatensatz probieren und nicht auf die ungesicherten Rohdaten loslassen.
VG
Option Explicit
Sub b_werte_clearen()
Dim ende As Long
Dim daten
Dim zeile As Long
Dim wertA As Variant
Dim wertB As Variant
Dim wechsel As Boolean
Dim zwischenspeicher As String
'Anzahl der Eintragungen
ende = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Daten aus Spalte A und B
daten = ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(ende, 2))
'durch alle Daten in Spalte A
wertA = ""
For zeile = 1 To ende
'schauen ob es leer ist
wertA = daten(zeile, 1)
If wertA <> "" Then
'Daten sind nicht leer, so lange bis ein andere Wert in A kommt
wechsel = False
'die schon vorhandenemn Werte
zwischenspeicher = ""
While wechsel = False
'prüfen ob der wert in B schonmal da war
If InStr(1, zwischenspeicher, daten(zeile, 2) & ";", vbTextCompare) > 0 Then
'der Wert war schonmal da, dann löschen
daten(zeile, 2) = ""
Else
'Wert war noch nicht da
zwischenspeicher = zwischenspeicher & daten(zeile, 2) & ";"
End If
'i nnächster Zeie schauen
zeile = zeile + 1
If zeile > ende Then
wechsel = True
Else
If daten(zeile, 1) <> wertA Then wechsel = True
End If
Wend
'wieder eins zurück da bei next der nöchste Wert kommt
zeile = zeile - 1
End If
Next zeile
'Daten wieder zurück schreiben
ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(ende, 2)) = daten
End Sub
|