Doppelte Einträge löschen

Hallo ihr Excelspezialisten,
ich habe ein Problem mit dem entfernen doppelter Einträge.
Hier im Forum wurde mir diesbezüglich bereits geholfen. Aber es hat sich die Prüfung erweitert.
Ursprünglich wurden die Tabellen Kontodaten Spalte A und Hilfstabelle Spalte C verglichen und die Werte in Hilfstabelle Spalte D gelöscht.
Das vorhandene Makro habe ich bereits auf Tabelle Kategorien geändert ebenso die Spalte von C auf F. Dieses Makro funktioniert soweit.
Aber ich benötige eine weitere Prüfung Kontodaten Spalte C mit Kategorien Spalte E.
Leider weiss ich nicht, wie ich das Makro ändern soll um auf das Ergebis zu gelangen.
In der Musterdatei habe ich in Tabelle Kategorien die letzten beiden Zeilen eingefügt, wobei eine Zeile übernommen werden soll die andere als doppelte gelöscht werden soll.
anbei Datei:https://www.herber.de/bbs/user/126227.xlsm
Könnt ihr mir bitte helfen.
Besten Dank
Gruss
Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Doppelte_entfernen() Dim loLetzte As Long Application.ScreenUpdating = False With Worksheets("Kategorien") loLetzte = .Cells(.Rows.Count, 3).End(xlUp).Row ActiveSheet.Range("$C$1:$F$" & loLetzte).RemoveDuplicates Columns:=Array(1, 2, 3, 4), _ Header:=xlYes End With Application.ScreenUpdating = True End Sub

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

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Doppelte Einträge löschen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread