Anzeige
Archiv - Navigation
544to548
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
544to548
544to548
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Doppelte Einträge löschen, und farblich markieren

Doppelte Einträge löschen, und farblich markieren
14.01.2005 14:12:56
Carsten
Mahlzeit!!
Ich hab ein kleines Problem, und hoffe auf Eure fachmännische Hilfe:
-Ausgangsmaterial ist eine Adress/Kundendatei in Excel 2003 mit Überschrift
- Doppelte bzw. 3-fach vorkommende Einträge sollen bis auf einen gelöscht werden
- der übrig gebliebene Eintrag soll farblich markiert werden
- das ganze sollte automatisch ablaufen. D.h. bei einem Neueintrag am Ende der Liste soll diese nach Spalte D sortiert werden und o.g. Prüfung stattfinden. (oder anders herum)
Bei Änderung welcher Zelle das Programm startet ist eigentlich egal.
- Spalte A: Anrede
- Spalte B: Vorname (kommt nicht immmer vor. Also evtl. leere Zelle)
- Spalte C: Nachname
- Spalte D: Firma (nach dieser Zelle soll selektiert !!UND!! sortiert werden)
- Spalte E: Anschrift
- Spalte F: PLZ (fehlt auch ab und zu)
- Spalte G: Tel.
- ...bis Spalte K
Über "Spezial- oder Autofilter" funktioniert das ganze leider nicht.
Auch mit Hilfe von Daten ... Gültigkeit ... Vergleich stellt sich nicht das gewünscht Ergebnis ein.
Ich werde wohl nicht drum herum kommen, das ganze in vba zu machen.
Ein netter Mitmensch (vielen Dank Werner!!) hat sich meines Problems angenommen, und folgende Lösung ausgetüftelt:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim laR As Long, i As Long
If Target.Column <> 4 Then Exit Sub
laR = Cells(Rows.Count, 2).End(xlUp).Row
Range("A2:K" & laR).Sort Key1:=Range("D2"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
For i = laR To 2 Step -1
If Cells(i, 2).Value = Cells(i - 1, 2).Value Then
Rows(i).Delete Shift:=xlUp
Cells(i - 1, 2).Interior.ColorIndex = 6
End If
Next i
End Sub

Das Programm funktioniert leider nicht ganz richtig. Es werden mir einfach viel zu viele Daten gelöscht, und ich finde den Fehler nicht.
MfG
Carsten

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelte Einträge löschen, und farblich markieren
WernerB.
Hallo Carsten,
ursprünglich war bei Dir die Spalte "B" entscheidend, jetzt ist es die Spalte "D".
Das Makro startet automatisch, wenn in Spalte "D" eine Änderung erfolgt oder ein Neueintrag vorgenommen wird. Jeder Name in der Spalte "D" wird nach der Makrobehandlung nur noch ein mal vorkommen.
Versuche es doch mal so:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim laR As Long, i As Long
If Target.Column <> 4 Then Exit Sub
laR = Cells(Rows.Count, 4).End(xlUp).Row
Range("A2:K" & laR).Sort Key1:=Range("D2"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
For i = laR To 3 Step -1
If Cells(i, 4).Value = Cells(i - 1, 4).Value Then
Rows(i).Delete Shift:=xlUp
Cells(i - 1, 4).Interior.ColorIndex = 6
End If
Next i
End Sub

Gruß
WernerB.
Anzeige
AW: Doppelte Einträge löschen, und farblich markieren
Carsten
Hallo Werner,
was für eine Überraschung heute morgen. Du hast Dir übers Wochenende wirlklich die Mühe gemacht, mir zu helfen. Und was für eine....
Das Programm läuft erste Sahne. Ich möchte mich von ganzem Herzen bei Dir bedanken!!!!
Du hast mir wirklich sehr geholfen.
MfG
Carsten

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige