Doppelte Werte finden - beide (!) löschen

Hallo zusammen!
Nachdem ich zum beliebten Thema "Doppelte" wirklich viele Einträge hier gelesen habe und dennoch ohne Lösung bin, versuche ich es auf diesem Weg.
Ich habe eine sehr umfangreiche Liste, die in einer Spalte teilweise doppelte Werte aufweist. Da mich aber nur die Werte interessieren, die einfach vorkommen, möchte ich die doppelten vollständig löschen. D.h. nicht nur die Duplikate entfernen sondern quasi auch den "Basiswert". Es sollen im Ergebnis also ausschließlich nur die Werte vorhanden sein, die ein einziges Mal vorkommen.
Über einen Filter konnte ich leider nichts machen und gefundene VBA-Codes brachten nicht den gewünschten Effekt. Diese zielen meist darauf ab, Duplikate zu erkennen um den "überschüssigen" Teil zu entfernen, nicht aber beide Werte.
Ich kann mir vorstellen, dass andere auch schon vor dem Problem standen und freue mich über jeden hilfreichen Hinweis. Schonmal vielen Dank im Voraus!
Jack

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jack,
da hast Du aber nicht genau gesucht. Das habe ich in den letzten 14 Tagen mehrmals beantwortet.


Option Explicit
Sub KeineDoppelten_Problem3()
'   erstellt von Hajo.Ziplies@web.deb 10.08.03
'   neue Tabelle anlegen, Sortieren und alle Doppelten löschen
'   Anzahl der doppelten eintragen
Dim LoAnzahl As Long    ' Anzahl der Doppelten
Dim LoI As Long         ' Schleifenvariablen außen
Dim LoJ As Long         ' Schleifenvariable innen
Dim ByAnzahl As Byte
Application.ScreenUpdating = False  ' Bildschirmanzeige aus
'   alte Tabelle Neu löschen und neue tabelle "Neu" mit Inhalt von Tabelle 1
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Neu").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets("Tabelle1").Copy Before:=Worksheets(1)
ActiveSheet.Name = "Neu"
'   Sortieren der Daten nach Spalte A ohne Übeschrift
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"), Order1:= _
xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'   doppelte löschen
LoAnzahl = 1
For LoI = Cells(Rows.Count, 6).End(xlUp).Row - 1 To 1 Step -1
ByAnzahl = 0
For LoJ = 1 To 8
If Trim(Cells(LoI, LoJ)) = Trim(Cells(LoI + 1, LoJ)) Then
ByAnzahl = ByAnzahl + 1
End If
Next LoJ
If ByAnzahl = 8 Then
LoAnzahl = LoAnzahl + 1
Rows(LoI).Delete
Else
'            Cells(LoI + 1, 10) = LoAnzahl
If LoAnzahl > 1 Then Rows(LoI + 1).Delete
LoAnzahl = 1
End If
Next LoI
'    Cells(1, 10) = LoAnzahl
If LoAnzahl > 1 Then Rows(1).Delete
Application.ScreenUpdating = True  ' Bildschirmanzeige ein
Application.CutCopyMode = False    ' Zwischenspeicher löschen
End Sub

Sub Doppelte_Loeschen() Const z1 = 1 'Suche ab Zeile 1 Const Sp = 1 ' Werte in Spalte 1 vergleichen Dim z As Long, z2 As Long Dim doppelt() As Boolean Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'letzte Zeile ermitteln: With Cells(Rows.Count, Sp) If .Value "" Then z2 = Rows.Count Else z2 = Cells(Rows.Count, Sp).End(xlUp).Row End If If z2 = 1 And Cells(1, Sp) = "" Then z2 = 0 End With Debug.Print z1, z2 If z1 1 Then doppelt(z) = True Else doppelt(z) = False End If Next z 'markierte Zeilen löschen For z = z2 To z1 Step -1 If doppelt(z) Then Rows(z).Delete Shift:=xlUp Next z End If Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Doppelte Werte finden - beide (!) löschen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Doppelte Werte finden - beide (!) löschen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread