Doppelte Einträge löschen

Forumthread: Doppelte Einträge löschen

20.12.2018 10:40:17

Peter

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

AW: Doppelte Einträge löschen

20.12.2018 10:45:17

Daniel

Hi
für diese Aufgabe gibt es in Excel die Menüfunktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN
das kann man auch in VBA verwenden, der Recorder hilft dir dabei, den entsprechenden VBA-Befehl zu finden.
Gruß Daniel

AW: Doppelte Einträge löschen

20.12.2018 10:58:17

Peter

Hallo Daniel,
besten Dank für Deine HIlfe.
Klappt einwandfrei.
Gruss
Peter

AW: Doppelte Einträge löschen

20.12.2018 11:31:08

Peter

Hallo Daniel,
ich habe das entfernen der doppelten Einträge mit nachstehendem Makro umgesetzt:

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

Wobei ich jetzt noch ein Problem habe ist mit einer Mitteilung in ein Label in einer Userform, dass der doppelte Eintrag gelöscht wurde.
Wie kann unterschieden werden, ob ein Eintrag gelöscht wurde oder nicht?
Kannst Du mir bitte dabei helfen.
Gruss
Peter

AW: Doppelte Einträge löschen

20.12.2018 11:36:47

Daniel

Ein eintrag, der gelöscht wurde, ist nicht mehr da.
daran kann man ihn erkennen.
Weil es schwierig ist, etwas zu erkennen was nicht da ist, musst du, wenn du die gelöschten Zeilen anzeigen willst, diese vorher ermitteln.
dazu könntest du vor dem Löschen in einer Hilfsspalte mit ZählenWenns ermitteln, wie oft ein Eintrag vorkommt und alle auflisten, bei denen da eine 2 oder mehr steht.
Gruß Daniel

AW: Doppelte Einträge löschen

20.12.2018 11:53:27

Daniel

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

AW: Doppelte Einträge löschen

20.12.2018 11:38:51

Peter

Hallo Daniel,
besten Dank für diesen Tip - werde ich einbauen.
Gruss
Peter

Beliebteste Forumthreads (12 Monate)

Forumthread: Doppelte Einträge löschen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Doppelte Einträge löschen

Forumthread: Doppelte Einträge löschen

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread