Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Doppelte Zeileneinträge innerhalb eines Bereiches per VBA löschen

884 views
Skip to first unread message

Daniel Roth

unread,
Aug 20, 2001, 1:44:16 PM8/20/01
to
Hallo zusammen

Ich bin in Excel VBA etwas unfit - nun habe ich ein Problem: ich markieren
einen Tabellenbereich mit folgendem code:

Range("C2").Select

Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select '
Damit entferne ich die Überschrift aus der Markierung

Nun weist mein markierter Bereich (er geht über mehrere Zeilen und insgesamt
6 Spalten) jedoch zeilenweise doppelte Einträge auf; wie kann ich nach
diesen doppelten Einträgen suchen und diese Zeilen (bzw sechs Zellen
nebeneinander) löschen, damit ich nicht mit einem Spezialfilter rumhantieren
muss?

Vielen Dank für eure potentiellen Antworten

Daniel Roth


Wolf W. Radzinski

unread,
Aug 20, 2001, 2:05:55 PM8/20/01
to

Daniel Roth schrieb in Nachricht ...

>Nun weist mein markierter Bereich (er geht über mehrere Zeilen und
insgesamt
>6 Spalten) jedoch zeilenweise doppelte Einträge auf; wie kann ich nach
>diesen doppelten Einträgen suchen und diese Zeilen (bzw sechs Zellen
>nebeneinander) löschen, damit ich nicht mit einem Spezialfilter
rumhantieren
>muss?


z.B.

http://www.rendar.de sub's (6a) "Finde und Lösche Duplikate"

Daniel Roth

unread,
Aug 20, 2001, 3:00:11 PM8/20/01
to
Hallo Herr Radzinski

Besten Dank für Ihre Antwort - ich war auf Ihrer (?) Seite und habe den
entsprechenden Code angeschaut; zu meiner Schande: ich verstehe ihn nicht
und kann ihn deshalb auch nicht implementieren bzw. austesten.

Nochmals zu meinem Problem: ein Range (zbsp C2:H5 - also 4 Zeilen und 6
Spalten) enthält zeilenweise gleiche Einträge - die redundanten möchte ich
löschen - und: die doppelten Einträge müssen nicht zwingendermassen
nacheinander folgen - wie würde ich nun den Code einbauen?

viele Grüsse

Daniel Roth


Wolf W. Radzinski schrieb in Nachricht
<9lrjld$nms$03$1...@news.t-online.com>...

Wolf W. Radzinski

unread,
Aug 20, 2001, 3:49:05 PM8/20/01
to

Wolf W. Radzinski schrieb in Nachricht
<9lrpgd$h7d$07$1...@news.t-online.com>...


>alle Duplikate sind jetzt hellrot markiert - die Unikate gelb

muß heißen ...

alle Duplikate sind jetzt hellrot markiert - die zugehörigen Originale
gelb - und die UNIKATE sind NICHT markiert

Wolf W. Radzinski

unread,
Aug 20, 2001, 3:45:13 PM8/20/01
to

Daniel Roth schrieb in Nachricht ...
>Hallo Herr Radzinski
>
>Besten Dank für Ihre Antwort - ich war auf Ihrer (?) Seite und habe den
>entsprechenden Code angeschaut; zu meiner Schande: ich verstehe ihn
nicht
>und kann ihn deshalb auch nicht implementieren bzw. austesten.
>
>Nochmals zu meinem Problem: ein Range (zbsp C2:H5 - also 4 Zeilen und 6
>Spalten) enthält zeilenweise gleiche Einträge - die redundanten möchte
ich
>löschen - und: die doppelten Einträge müssen nicht zwingendermassen
>nacheinander folgen - wie würde ich nun den Code einbauen?


Beschreibung für Excel 97 (2000 sollte hoffentlich ähnlich
funktionieren?)

1.) die Datei finde_gleiche2.bas runterladen

http://www.rendar.de/excel

dort die Datei finde_gleiche2.bas suchen mit RECHTER Maustaste anklicken
und mit "Ziel speichern unter" auf die eigene Festplatte runterladen ...
den Ordner notieren oder merken!

2.) Excel öffnen - die gewünschte Arbeitsmappe öffnen -

3.) mit Tastenkombination <ALT><F11> in den VBA Editor wechseln

4.) mit Tastenkombination <STRG><M> bzw. Datei>Datei importieren ... die
zuvor runtergeladene Datei "finde_gleiche2.bas" in die Mappe
importieren

5.) das VBA Editorfenster schließen - d.h. zurück zum Tabellenblatt der
geöffneten Arbeitsmappe

6.) mit <ALT><F8> die Funktion set_parameter_ip aufrufen und das Wort
"löschen" durch "auflisten" (ohne Anführungszeichen!) ersetzen, die
Inputbox wieder schließen

7.) die Spalten C bis H mit der Maus markieren

8.) mit <ALT><F8> die Funktion teste_auf_gleich aufrufen

9.) mit <ALT><F8> die Funktion zeige_alle_treffer aufrufen

alle Duplikate sind jetzt hellrot markiert - die Unikate gelb

10.) mit <ALT><F8> weitere Funktionen aufrufen

z.B. verstecke_alle_doppelten
zeige_alle_doppelten

DU WILLST aber entferne_alle_doppelten

dadurch werden in den Spalten C bis H die Duplikate gelöscht

WILLST DU DIE GANZE ZEILE LÖSCHEN nimm stattdessen

die Funktion lösche_GANZE_duplikatzeilen

NOCH WAS!! Mein Code vergleicht immer ALLE Zeilen im UsedRange (im
genutzen Bereich) also ganze Spalte C bis H ... die Möglichkeit nur
bestimmte Zeilen (z.B. 2 bis 5) herauszufiltern hab ich noch nicht
eingebaut - wäre aber theoretisch auch kein größeres Problem - man müßte
der Funktion dann nur 2 weitere parameter Anfangs- und Endzeile
übergeben.

-wr-

Daniel Roth

unread,
Aug 20, 2001, 4:38:56 PM8/20/01
to
Hallo Wolf

Besten Dank für Deine ausführliche Anleitung; ich konnte Deinen Code
implementieren, jedoch scheint dieser in einer endlosen Schlaufe zu hängen
(ich habe die Einzelschritte mit F8 mal durchgetestet...) - ich konnte Teile
von Deinem Code dann richtig und funktionsfähig implementieren, wenn ich
diese Teile mit meinem Code verbinde, klappts leider noch immer nicht. nun,
mein Latein und die Geduld sind bei mir langsam am Ende, ich denke, ich haue
mich in die Heia und versuche es danach nochmals. Auf jeden Fall nochmals
tausend Dank und viele Grüsse

Daniel

Wolf W. Radzinski schrieb in Nachricht

<9lrpmr$g92$02$1...@news.t-online.com>...

Wolf W. Radzinski

unread,
Aug 20, 2001, 5:35:56 PM8/20/01
to

Daniel Roth schrieb in Nachricht ...

>Besten Dank für Deine ausführliche Anleitung; ich konnte Deinen Code


>implementieren, jedoch scheint dieser in einer endlosen Schlaufe zu
hängen
>(ich habe die Einzelschritte mit F8 mal durchgetestet...)

nee, keine Endlosschleife, aber ... bisher leider relativ LANGSAM (*)
:-( ich hab die simple For-Schleife nämlich noch nicht durch besseren
(und schnelleren) Code ersetzt (ich werde eventuell die Selection in ein
weiteres temporäres Arbeitsblatt kopieren - dann dort sortieren - und
erst dann nach Duplikaten suchen - hab's noch nicht entschieden! Die
wirklich GUTE Idee zur Beschleunigung fehlt mir noch ... übrigens! ...
der excelinterne Spezialfilter ist auch nicht gerade das Gelbe vom Ei -
bei großen Datenmengen z.B. bei ca. 65000 Zeilen kann das schon mal
12-15 Minuten dauern!

(*) wenn deine UsedRange ziemlich groß ist, dann kann das dauern!! mit
<Strg><Ende> solltest du die letzte Zelle der UsedRange anspringen
können - WELCHE Zeile ist das?

Ansonsten bleibt dir leider imho nur der Excel- Spezialfilter (1)
oder warten bis ich meinen Code geändert hab

(1) Daten > Filter > Spezialfilter > dort nur "keine Duplikate"
ankreuzen ... wenn Zeile 1 keinen Titel enthält eine Titelzeile einfügen
und dann den Spezialfilter anwenden

Wolf W. Radzinski

unread,
Aug 20, 2001, 5:54:05 PM8/20/01
to

den Excel Spezialfilter in VBA einfügen? ...

'Zeile 1 sollte keine Daten, sondern
'Titel enthalten!

'Spalten C bis H markieren
Columns("C:H").Select
'und den Spezialfilter anwenden
ActiveSheet.UsedRange.AdvancedFilter _
Action:=xlFilterInPlace,Unique:=True

Peter Haserodt

unread,
Aug 21, 2001, 6:13:43 AM8/21/01
to
Hi,
als Workaround, musst du für dich anpassen.

Im Beispiel wird die Spalte A ab A3 (erster Eintrag) auf doppelte Einträge
untersucht.
Spalte B wird zur Untersuchung benutzt.
Doppelte Einträge werden dann die Zeilen gelöscht.

Sub ZeilenDoppeltLoeschen()
Dim oRange As Range, oSuchRange As Range
Dim Zelle1 As Long, Zelle2 As Long, sFormeltext As String
'ISTZAHL(VERGLEICH(A3;BEREICH.VERSCHIEBEN($A$1;0;0;ZEILE(A3)-1;1);0))
' obiges stammt nicht von mir habe ich gelesen
'Guter Trick zum Duplikate finden
'Der Rest ist von mir
Debug.Print Time
Set oSuchRange = [A3].CurrentRegion
Zelle1 = oSuchRange.Row
Zelle2 = oSuchRange.Rows.Count + Zelle1 - 1
sFormeltext = "=if(isnumber(match(" & _
"A" & Zelle1 & ",Offset($A$1,0,0,Row(" & _
"A" & Zelle1 & ")-1,1),0)),0,"""")"
ActiveSheet.Cells(Zelle1, 2).Formula = sFormeltext
Cells(Zelle1, 2).AutoFill Destination:=Range(Cells(Zelle1, 2), Cells(Zelle2,
2))

On Error Resume Next
Set oRange = Range(Cells(Zelle1, 2), Cells(Zelle2,
2)).SpecialCells(xlCellTypeFormulas, xlNumbers)
If oRange Is Nothing Then
MsgBox "No Double"
Exit Sub
End If
oRange.EntireRow.Delete
Debug.Print Time

End Sub


--
www.haserodt.de


Wolf W. Radzinski

unread,
Aug 21, 2001, 7:24:24 AM8/21/01
to

Peter Haserodt schrieb in Nachricht ...

>als Workaround, musst du für dich anpassen.
>
>Im Beispiel wird die Spalte A ab A3 (erster Eintrag) auf doppelte
Einträge
>untersucht.
>Spalte B wird zur Untersuchung benutzt.
>Doppelte Einträge werden dann die Zeilen gelöscht.


und wie untersucht er jetzt ob in Spalte C bis H die Zellen zweier
Zeilen identischen Inhalt haben? Erst DANN ist es ein Duplikat! Muß er
jetzt die Inhalte von C bis H in Spalte A hintereinander kopieren um auf
Duplikate testen zu können?

Es geht übrigens mit dem Spezialfilter auch recht einfach und flott UND
ZWAR vergleicht der Filter die Zellinhalte von Spalte C bis H und findet
die Duplikate auf diese Art!

so ungefähr ...

Sub doppelte_ausblenden()
Columns("C:H").Select
Selection.AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True
End Sub


Sub und_hiermit_loeschen()
Dim r As Range
Application.DisplayAlerts = False
With ActiveSheet
lastrow = Range("$C$2:$H$65536"). _
End(xlDown).Row
If lastrow < 2 Then Exit Sub
For Each r In Rows("2:" & lastrow)
If r.Hidden Then .Range(.Cells(r.Row, 3), _
.Cells(r.Row, 8)).Delete shift:=xlUp
Next
End With
Application.DisplayAlerts = True
End Sub

Peter Haserodt

unread,
Aug 21, 2001, 8:20:43 AM8/21/01
to
Hi,

Wenn er mehrere Zellen einer Zelle vergleichen will
ist es doch ein einfaches in einer Weiteren Hilfsspalte
eine Verkettung zu erstellen:
von mir aus die Spalten a - c dann

in Spalte X : =a&b&c
dann ein filldown und
in spalte Y dann den von mir beschriebenen Vorgang bezogen auf die Spalte x

Fertig.
Und danach natürlich für die beiden Spalten ein clearcontents


Man kann damit einfach ziemlich viel machen.
Aber anpassen muss mans

Vergleich mal die beiden Varianten bei grosser Anzahl von Löschzeilen

Gruß Peter

--
www.haserodt.de


Wolf W. Radzinski

unread,
Aug 21, 2001, 8:17:23 AM8/21/01
to

Wolf W. Radzinski schrieb in Nachricht
<9ltggf$nk7$05$1...@news.t-online.com>...

>Es geht übrigens mit dem Spezialfilter auch recht einfach und flott UND
>ZWAR vergleicht der Filter die Zellinhalte von Spalte C bis H und
findet
>die Duplikate auf diese Art!


hab's mal den Spezialfilter-Code getestet und in Zelle C2:H1002
ganzzahlige Zufallszahlen zw. 0 und 4 eingetragen (und die Formel
Ganzzahl(Zufallszahl()*5) natürlich vor dem Test durch die jeweiligen
Zufallswerte ersetzt!)

Die Prüfung bzw. Filterung mit dem excelinternen Spezialfilter (ohne
Löschung der Duplikate) dauerte je Versuch ca 250-275 Sekunden und es
wurden dabei jeweils ca. 15 bis 30 Duplikate gefunden.

Wolf W. Radzinski

unread,
Aug 21, 2001, 8:35:06 AM8/21/01
to

Peter Haserodt schrieb in Nachricht ...
>Hi,
>
>Wenn er mehrere Zellen einer Zelle vergleichen will
>ist es doch ein einfaches in einer Weiteren Hilfsspalte
>eine Verkettung zu erstellen:
>von mir aus die Spalten a - c dann
>
>in Spalte X : =a&b&c


angenommen

Spalte A B C ---> X
1 10 51 11051
110 5 1 11051 aha :-) prima Duplikat!

und jetzt verketten :-) und dann auf Gleichheit prüfen? Das geht wohl
nur bei FESTER Breite im variablen Fall wirst du damit nicht glücklich

Wolf W. Radzinski

unread,
Aug 21, 2001, 8:48:34 AM8/21/01
to

Peter Haserodt schrieb in Nachricht ...

>in Spalte X : =a&b&c


du müßtest ein SONDERZEICHEN(kombination) sz definieren, welche(s) auf
keinen Fall im Text irgendeiner der betroffenen Zellen vorkommen darf
und dann

= a & sz & b & sz & c verknüpfen

das wäre eine Möglichkeit - nur - wenn die einzelnen Textbausteine a,b,c
LANG sind (und das sind sie und auch noch von ganz unterschiedlichem
Datentyp!) besteht die Gefahr, daß der Resultatstring irgendwann zu lang
wird ... und dann? ... Hast du ein neues Problem ...

Peter Haserodt

unread,
Aug 21, 2001, 9:02:17 AM8/21/01
to
= a3 & ";\" & b3 & ";\" &c3

(Standard für Verkettungen von Parallelwerten,
wenn diese überprüft, bzw wieder geteilt werden sollen,
nimmt man sich noch einen unwahrscheinlichen Eintragstrenner hinzu)

Gruß Peter

Peter Haserodt

unread,
Aug 21, 2001, 9:54:34 AM8/21/01
to
Hi,
habe deinen Versuch nachgestelltt mit meiner Variante:

Mit Löschen der Zeilen: ca 1 Sekunde

Gruß Peter


Peter Haserodt

unread,
Aug 21, 2001, 10:30:39 AM8/21/01
to
Hi,

>das wäre eine Möglichkeit - nur - wenn die einzelnen Textbausteine a,b,c
>LANG sind (und das sind sie und auch noch von ganz unterschiedlichem
>Datentyp!) besteht die Gefahr, daß der Resultatstring irgendwann zu lang
>wird ... und dann? ... Hast du ein neues Problem ...

Das ist wohl wahr, bei ges. > 255 scheints zu platzen
aber dies ist wohl vorhersehbar.
(Wobei man das sicherlich auch prüfen könnte, geht ja schnell,
also in einer weiteren Spalte die Länge der verketteten Zelle und ein Max
über die
Spalte wenn dies einen wert Überschreitet, dann eine andere Methode)
Das prüfen dürfte etwa 1 Sekunde beanspruchen und ist sicherlich diese
Sekunde Wert, wenn man bei Erfolg unendlich viel Zeit sparen kann

Gruß Peter


Wolf W. Radzinski

unread,
Aug 21, 2001, 1:26:57 PM8/21/01
to

Peter Haserodt schrieb in Nachricht ...

>Das ist wohl wahr, bei ges. > 255 scheints zu platzen
>aber dies ist wohl vorhersehbar.


das hab ich erst vor kurzem leidvoll erfahren :-( beim Versuch eine
aktive Selection bezüglich des restlichen Arbeitsblattes zu invertieren
hatte ich zuerst mit Selection.Address gespielt, bis ich feststellte,
das .Address nach spätestens 256 Zeichen einfach abgeschnitten wird und
es war elend langsam - so war's also nix mit der "punktgenauen"
Invertierung :-( hab dann stattdessen Selection.Areas dafür entdeckt und
verwendet, damit klappt die Invertierung bei beliebig komplexen
Selektionen innerhalb von Millisekunden

findest du z.Zt. auf http://wradner.gmxhome.de/excel


Peter Haserodt

unread,
Aug 21, 2001, 6:06:53 PM8/21/01
to
>hab dann stattdessen Selection.Areas dafür entdeckt

Für diese Entdeckung brauch ich keine HP ;-))))
Areas sind schon aus Kolumbus-Zeiten bekannt ;-)
Jedenfalls für die, die sich schon mit Union und anderen
Excel Feinheiten beschäftigt haben ;-))


Gruss Peter

--
www.haserodt.de


Wolf W. Radzinski

unread,
Aug 21, 2001, 7:19:17 PM8/21/01
to

Peter Haserodt schrieb in Nachricht ...

>Für diese Entdeckung brauch ich keine HP ;-))))

das hab ich auch nicht angenommen :-) wer Schulungen anbietet sollte die
Materie zu 100% "im Schlaf" beherrschen :-)

>Areas sind schon aus Kolumbus-Zeiten bekannt ;-)

ich als "blutiger Excelanfänger" (mit OOP Hintergrund) hab Areas zum
ersten Mal verwendet - jetzt weiß ich aber wenigstens wozu man die z.B.
verwenden KANN.

>Jedenfalls für die, die sich schon mit Union und anderen
>Excel Feinheiten beschäftigt haben ;-))


Union -in Excel- hab ich sowas vorher auch noch nie benötigt :-) ehrlich
gesagt hab ich mein ganzes spärliches Excel Wissens aus den NG's, aus
msdn.microsoft.com und der Excel Objektbibliothek (der Rest der Excel
Hilfe hat noch nie ohne Absturz auf meinem PC funktioniert) imho -
reicht das aber vollkommen, um in Excel einigermaßen fit zu werden.

-wr-

Peter Haserodt

unread,
Aug 22, 2001, 7:48:00 AM8/22/01
to
Hi

>wer Schulungen anbietet sollte die
Materie zu 100% "im Schlaf" beherrschen :-)

Wer das von sich behauptet , ich meine die 100 %, leidet sicherlich an
Größenwahn ;-)))

Wichtig ist das man das Objekt versteht und sich dementsprechend
auf die Suche machen kann.

Ich persönlich finde die Hilfe von Excel recht brauchbar.
Gruß Peter


0 new messages