AW: Doppelte Einträge löschen
20.12.2018 15:29:09
Peter
Hallo Daniel,
habe den Code umgebaut und er funktioniert einwandfei.
Public Sub doppelte_Werte_entfernen2()
Dim loLetzte As Long, loLetzteKo As Long
Dim loSpalte As Long, loLetzteAlt As Long, i As Long
Dim strSuchbegriff As String
Application.ScreenUpdating = False
With Worksheets("Kontodaten")
loLetzteKo = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With Worksheets("Kategorien")
loLetzte = .Cells(.Rows.Count, 3).End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
loLetzteAlt = loLetzte
End With
For i = 2 To loLetzteKo
strSuchbegriff = """" & Worksheets("Kontodaten").Cells(i, 1) & """"
With Worksheets("Kategorien")
loLetzte = .Cells(.Rows.Count, 3).End(xlUp).Row
.Range(.Cells(2, loSpalte), .Cells(loLetzte, loSpalte)).FormulaLocal = _
"=WENN(ZÄHLENWENNS(C:C;" & strSuchbegriff & ";C:C;C2;F:F;F2)>1;0;ZEILE())"
.Range(.Cells(2, loSpalte), .Cells(loLetzte, loSpalte)).Value = _
.Range(.Cells(2, loSpalte), .Cells(loLetzte, loSpalte)).Value
.Cells(1, loSpalte) = 1
' .Range(.Cells(1, 3), .Cells(loLetzte, loSpalte)).RemoveDuplicates Columns:=loSpalte - _
2, Header:=xlNo
.Range("$C$1:$F$" & loLetzte).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:= _
xlYes
.Columns(loSpalte).ClearContents
End With
Next i
''!!! wird nur in Verbindung mit UserForm benötigt nicht für Test
''With Worksheets("Kategorien")
'' loLetzte = .Cells(.Rows.Count, 3).End(xlUp).Row
'' If loLetzteAlt > loLetzte Then
'' UF_Kategorien_neu.Label15.Caption = "Eintrag doppelt - gelöscht"
'' Else
'' UF_Kategorien_neu.Label15.Caption = "Keine doppelten Einträge"
'' End If
''End With
With Worksheets("Kategorien")
loLetzte = .Cells(.Rows.Count, 3).End(xlUp).Row
If loLetzteAlt > loLetzte Then
' UF_Kategorien_neu.Label15.Caption = "Eintrag doppelt - gelöscht"
MsgBox "Eintrag doppelt - gelöscht"
Else
' UF_Kategorien_neu.Label15.Caption = "Keine doppelten Einträge"
MsgBox "Keine doppelten Einträge"
End If
End With
End Sub
Nochmals besten Dank für Deine Hilfe.
Wünsche Dir ein schönes Weihnachtsfest und ein gesundes neues Jahr 2019.
Gruss
Peter