VBA Wie finde ich doppelte Einträge in einer Spalte.
Juergen Lankenau
ich hab hier was in VBA programmiert. Es gibt eine Spalte meines
Tabellenblattes in der keine Doppel auftreten dürfen. Bei der Eingabe kann
ich das verhindern, aber was ist wenn jemand die Tabelle direkt manipuliert
und Sie dann wieder meinem "Tool" unterjubelt. Wie finde ich am
geschicktesten Doppeleinträge? 'ne Warnung das Doppeleinträge vorhanden
sind, würde auch schon reichen.
MfG Jürgen Lankenau
Frank Arendt-Theilen
<jlan...@nwn.de> in microsoft.public.de.excel zu "VBA Wie finde ich
doppelte Einträge in einer Spalte.":
Hallo Jürgen,
wie folgt:
Sub GleicheWerteInEinerSpalte()
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Worksheets(1).Range(ActiveCell.CurrentRegion.Address)
ActiveCell.End(xlUp).Select
Wert = ActiveCell.Value
For I = 1 To Bereich.Cells.Count - 1
For Each Zelle In Bereich
If ActiveCell.Address <> Zelle.Address Then
If Zelle.Value = Wert Then
Auswahl = MsgBox("Die folgenden Zellen weisen " & vbLf & _
"den gleichen Wert auf: " & vbLf & _
ActiveCell.Address & vbLf & Zelle. _
Address, vbOKCancel + vbCritical, "Gleiche Zellinhalte!")
If Auswahl = vbCancel Then Exit Sub
End If
End If
Next Zelle
ActiveCell.Offset(1, 0).Select
Set Bereich = Worksheets(1).Range(ActiveCell.Address, _
ActiveCell.End(xlDown).Address)
Wert = ActiveCell.Value
Next I
End Sub
Voraussetzung:
- der Zellzeiger wurde in der zu durchsuchenden Spalte positioniert,
aber nicht am Anfang bzw. Ende
- der zu durchsuchende Bereich darf keine Leerzellen enthalten.
MfG Frank
__________________________________________________________
E-Mail: Thei...@t-online.de
Martin Beck
mal angenommen, die betreffende Spalte ist A und die Einträge beginnen in A2
und in A1 steht eine Spaltenüberschrift. Folgendes Makro:
Sub DoppelteEinträgeFinden()
z1 = [A1].CurrentRegion.Rows.Count
Range("A1:A" & z1 & "").AdvancedFilter Action:=xlFilterInPlace,
Unique:=True
z2 = ActiveSheet.[A1].CurrentRegion.SpecialCells(xlVisible).Count
If z2 < z1 Then MsgBox "Doppelte Einträge"
ActiveSheet.ShowAllData
End Sub
Gruß
Martin Beck
Juergen Lankenau <jlan...@nwn.de> schrieb in im Newsbeitrag:
#bCMbwju#GA....@ntdwwaaw.compuserve.com...
> Hallo,
> ich hab hier was in VBA programmiert. Es gibt eine Spalte meines
> Tabellenblattes in der keine Doppel auftreten dürfen. Bei der Eingabe kann
> ich das verhindern, aber was ist wenn jemand die Tabelle direkt
manipuliert
> und Sie dann wieder meinem "Tool" unterjubelt. Wie finde ich am
> geschicktesten Doppeleinträge? 'ne Warnung das Doppeleinträge vorhanden
> sind, würde auch schon reichen.
>
> MfG Jürgen Lankenau
>
>
Martin Beck
an so eine Schleifenlösung habe ich zuerst auch gedacht. Aber: Hast Du das
Makro mal getestet? Bei 200 Werten läuft es auf meinem PC ca. 15 Sekunden
und die Laufzeit steigt exponentiell.
Jürgen reicht es ja, festzustellen, ob überhaupt doppelte Einträgevorliegen
(und nicht unbedingt welche). Daher ziehe ich den Weg über den
Spezialfilter vor. Hier noch eine verbesserte Version:
Sub DoppelteEinträgeFinden()
z1 = [A1].CurrentRegion.Rows.Count
Range("A1:A" & z1 & "").AdvancedFilter Action:=xlFilterInPlace,
Unique:=True
z2 = ActiveSheet.[A1].CurrentRegion.SpecialCells(xlVisible).Count
If z2 < z1 Then
MsgBox "Doppelte Einträge"
ActiveSheet.ShowAllData
Else MsgBox "Keine doppelten Einträge"
End If
End Sub
Gruß
Martin Beck
P.S. Ich wollte noch erwähnen, daß ich Deinen Einsatz hier in der NG sehr
schätze.
Frank Arendt-Theilen <Thei...@t-online.de> schrieb in im Newsbeitrag:
376be4a6...@msnews.microsoft.com...
> Am Sat, 19 Jun 1999 12:13:13 +0200, schrieb "Juergen Lankenau"
> <jlan...@nwn.de> in microsoft.public.de.excel zu "VBA Wie finde ich
> doppelte Einträge in einer Spalte.":
Juergen Lankenau
Dein Tip ist Gold wert !
ich hab die Idee aufgenommen und das Ganze folgendermaßen für meine
"Umgebung" umkonstruiert:
Sub DoppelteEinträgeFinden()
z1 = Application.CountA(pro_anw.Worksheets("tabelle1").Range("b:b"))
pro_anw.Worksheets("tabelle1").Range("B1:B" & z1 & "").AdvancedFilter
Action:=xlFilterInPlace, Unique:=True
z2 =
Application.CountA(pro_anw.Worksheets("tabelle1").Range("b:b").SpecialCells(
xlVisible))
If z2 < z1 Then MsgBox "doppelte Nummer"
pro_anw.Worksheets("tabelle1").ShowAllData
End Sub
Auch bei 300 Zeilen kein Problem ! Genial !
MfG Jürgen Lankenau
Martin Beck <marti...@metronet.de> schrieb in im Newsbeitrag:
7kj3o4$jk8$1...@news.dnsg.net...
> Hallo Jürgen,
>
> mal angenommen, die betreffende Spalte ist A und die Einträge beginnen in
A2
> und in A1 steht eine Spaltenüberschrift. Folgendes Makro:
>
> Sub DoppelteEinträgeFinden()
> z1 = [A1].CurrentRegion.Rows.Count
> Range("A1:A" & z1 & "").AdvancedFilter Action:=xlFilterInPlace,
> Unique:=True
> z2 = ActiveSheet.[A1].CurrentRegion.SpecialCells(xlVisible).Count
> If z2 < z1 Then MsgBox "Doppelte Einträge"
> ActiveSheet.ShowAllData
> End Sub
>
> Gruß
> Martin Beck
>
Frank Arendt-Theilen
<marti...@metronet.de> in microsoft.public.de.excel zu "Re: VBA Wie
finde ich doppelte Einträge in einer Spalte.":
>Hallo Frank,
>
>an so eine Schleifenlösung habe ich zuerst auch gedacht. Aber: Hast Du das
>Makro mal getestet? Bei 200 Werten läuft es auf meinem PC ca. 15 Sekunden
>und die Laufzeit steigt exponentiell.
>
>Jürgen reicht es ja, festzustellen, ob überhaupt doppelte Einträgevorliegen
>(und nicht unbedingt welche). Daher ziehe ich den Weg über den
>Spezialfilter vor. Hier noch eine verbesserte Version:
>
>Sub DoppelteEinträgeFinden()
> z1 = [A1].CurrentRegion.Rows.Count
> Range("A1:A" & z1 & "").AdvancedFilter Action:=xlFilterInPlace,
>Unique:=True
> z2 = ActiveSheet.[A1].CurrentRegion.SpecialCells(xlVisible).Count
> If z2 < z1 Then
> MsgBox "Doppelte Einträge"
> ActiveSheet.ShowAllData
> Else MsgBox "Keine doppelten Einträge"
> End If
>End Sub
>
>Gruß
>Martin Beck
>
>P.S. Ich wollte noch erwähnen, daß ich Deinen Einsatz hier in der NG sehr
>schätze.
Hallo Martin,
Zunächst einmal, danke für das Lob!
Ja, du hast vollkommen Recht, das Laufzeitverhalten meines Makros ist
mangelhaft. Dein Makro ist da wesentlich flotter. Dennoch bin ich mit
dieser Lösung auch nicht ganz zufrieden.Es wird bei deinem Makro nicht
deutlich ob mehrfach doppelte Einträge vorliegen. Zum anderen finde
ich es schon bei einer relativ geringen Anzahl von Zellen es mühsam
nachträglich herauszufinden welche Zellwerte denn nun doppelt sind.
Darum habe ich mich zu dem folgenden Makro als Zwischenlösung
durchgerungen (Laufzeit bei ca. 40.000 Zellen ca. 20 sec):
Sub GleicheWerteInSpalte()
Dim lngI As Long
Dim strQuellBlatt As String
Dim lngZellAnzahl As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
strQuellBlatt = ActiveSheet.Name
lngZellAnzahl = Range(ActiveCell.Address, _
ActiveCell.End(xlDown).Address).Rows.Count
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
Worksheets(strQuellBlatt).Range(ActiveCell.Address, _
ActiveCell.End(xlDown).Address).Copy _
Worksheets(Worksheets.Count).Range("A1")
Selection.Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For lngI = 1 To lngZellAnzahl
If Cells(lngI, 1).Value = Cells(lngI + 1, 1) Then
MsgBox "Der Wert [" & Cells(lngI, 1).Value & _
"] ist doppelt vorhanden!", vbCritical
End If
Next
Worksheets(Worksheets.Count).Delete
Worksheets(strQuellBlatt).Activate
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Frank Arendt-Theilen
habe vergessen zu erwähnen, das in meinem letzten Beitrag für den
Ablauf des Makros der Zellzeiger in der obersten Zelle des zu
durchsuchenden Bereichs positioniert werden sollte, z. B.: es soll der
Bereich A1:A1000 auf doppelte Einträge durchsucht werden, dann den
Zellzeiger vor dem Start des Makro in A1 positionieren.
Martin Beck
das macht das Makro aber leider auch nicht schneller. Das Problem besteht
darin, daß eben bei n Werten insgesamt
n*(n-1)/2 Vergleiche durchgeführt werden müssen. Bei 200 Werten sind das
19900 Vergleiche, bei 1000 Werten bereits 499500. Insofern ist die
Schleifenlösung bei "großen" Fallzahlen m.E. unpraktikabel.
Allerdings habe ich bei vielen ähnlichen Problemstellungen bislang auch
nichts Besseres gefunden. Die Performance läßt aber mitunter durch
Sortierung der Daten verbessern. Wenn man in der hier gegebenen
Problemstellung die zu vergleichenden Daten zunächst aufsteigend sortiert,
genügt es, jeweils 2 benachbarte Werte auf Übereinstimmung zu vergleichen,
also in etwa
For i = 1 to n-1
If Cells(i, 1) = Cells(i+1, 1) Then
Msgbox ("Identisch bla bla...")
End If
Next i
Die Zahl der Vergleiche reduziert sich auf n-1. Abschließend müssen die
Daten ggf. zurücksortiert werden (Hierzu muß man ggf. vorher eine
Hilfsspalte mit einer durchlaufenden Numerierung anlegen.).
Gruß
Martin Beck
Frank Arendt-Theilen <Thei...@t-online.de> schrieb in im Newsbeitrag:
376f345...@msnews.microsoft.com...
Jörg Nissen
ich mische mich einfach mal in Eure Diskussion ein.
Eine einigermaßen schnelle Lösung für das Problem ist die Datenbankfunktion
DBAUSZUG. Bei 2000 Datensätzen komme ich bei der Prüfung auf doppelte Daten
auf eine Laufzeit von ca. 8 Sekunden.
Dabei habe ich folgendes Testszenario aufgebaut.
Werteliste in Spalte A mit Überschrift "Werte" und 1999 Zeilen mit Daten.
Suchbedingung in Spalte C mit Überschrift "Werte" und Formel in C2 (wird
über Makro verändert).
In Zelle B1 die Formel "=DBAUSZUG(A1:A2000;A1;C1:C2)"
In Zelle D1 die Formel "=FEHLER.TYP(B1)"
Ich nutze dabei die Eigenschaft von DBAUSZUG, bei doppelten Werten in einer
Datenbank den Fehler "#ZAHL!" zu liefern. Das entspricht dem Fehlertyp 6,
den ich über die Formel in D1 anzeige und im Makro nutze. Das Makro selbst
verändert in einer Schleife die Formel in C2 in "=A" & aktuelle Zeile.
Wenn nach der Änderung der Formel die Zelle D1 den Wert 6 hat, ist der
aktuell geprüfte Wert doppelt oder mehrfach in der Liste.
Wenn man nun noch die Zeilennummer des mehrfach aufgetretenen Wertes in eine
andere Spalte derselben Zeile schreibt, kann man nach dem Durchlauf des
Makros über diese Spalte filtern (alle Nichtleeren) und bekommt so eine
übersicht aller Duplikate mit der entsprechenden Zeilennummer in der
Datenbank.
Das Makro selbst sieht so aus:
Sub TestDouble()
Dim iRow As Long
With Worksheets("Tabelle1")
For iRow = 2 To .UsedRange.Rows.Count
.Cells(2, 3).Formula = "=R[" & Format(iRow - 2, "0") & "]C[-2]"
Next iRow
End With
End Sub
Für alle, die mit ähnlichen Problemen zu kämpfen haben, vielleicht eine
kleine Hilfe.
Jörg
Martin Beck <marti...@metronet.de> schrieb in im Newsbeitrag:
7komi0$bta$1...@news.dnsg.net...
> Hallo Frank,
>
> das macht das Makro aber leider auch nicht schneller. Das Problem besteht
> darin, daß eben bei n Werten insgesamt
> n*(n-1)/2 Vergleiche durchgeführt werden müssen. Bei 200 Werten sind das
> 19900 Vergleiche, bei 1000 Werten bereits 499500. Insofern ist die
> Schleifenlösung bei "großen" Fallzahlen m.E. unpraktikabel.
>
> Allerdings habe ich bei vielen ähnlichen Problemstellungen bislang auch
> nichts Besseres gefunden. Die Performance läßt aber mitunter durch
> Sortierung der Daten verbessern. Wenn man in der hier gegebenen
> Problemstellung die zu vergleichenden Daten zunächst aufsteigend sortiert,
> genügt es, jeweils 2 benachbarte Werte auf Übereinstimmung zu vergleichen,
> also in etwa
>
> For i = 1 to n-1
> If Cells(i, 1) = Cells(i+1, 1) Then
> Msgbox ("Identisch bla bla...")
> End If
> Next i
>
> Die Zahl der Vergleiche reduziert sich auf n-1. Abschließend müssen die
> Daten ggf. zurücksortiert werden (Hierzu muß man ggf. vorher eine
> Hilfsspalte mit einer durchlaufenden Numerierung anlegen.).
>
> Gruß
> Martin Beck
>
> Frank Arendt-Theilen <> schrieb in im Newsbeitrag:
Frank Arendt-Theilen
Am Tue, 22 Jun 1999 20:57:16 +0200, schrieb "Martin Beck"
<marti...@metronet.de> in microsoft.public.de.excel zu "Re: VBA Wie
finde ich doppelte Einträge in einer Spalte.":
>Hallo Frank,
>Allerdings habe ich bei vielen ähnlichen Problemstellungen bislang auch
>nichts Besseres gefunden. Die Performance läßt aber mitunter durch
>Sortierung der Daten verbessern. Wenn man in der hier gegebenen
>Problemstellung die zu vergleichenden Daten zunächst aufsteigend sortiert,
>genügt es, jeweils 2 benachbarte Werte auf Übereinstimmung zu vergleichen,
>also in etwa
>
>For i = 1 to n-1
>If Cells(i, 1) = Cells(i+1, 1) Then
>Msgbox ("Identisch bla bla...")
>End If
>Next i
>
>Die Zahl der Vergleiche reduziert sich auf n-1. Abschließend müssen die
>Daten ggf. zurücksortiert werden (Hierzu muß man ggf. vorher eine
>Hilfsspalte mit einer durchlaufenden Numerierung anlegen.).
>
Hallo Martin,
genau das macht die verbesserte Version meines Makros vom 22.06.. Kurz
noch einmal zum Kern des Programmablauf:
1) Es wird ein neues Arbeitsblatt erstellt.
2) In dieses Arbeistblatt wird der auf doppelte Einträge zu
durchsuchende Bereich hineinkopiert.
3) Dieser Bereich wird sortiert, sodas gleiche Einträge direkt
untereinander liegen
4) Es wird eine Schleife mit der Anzahl zu vergleichender Zellen
durchgeführt.
5) Vorgänger- und Nachgängerzelle werden verglichen. Bei Gleichheit
wird eine Meldung mit dem Wert der aktuellen Zelle ausgegeben.
6) Das 'Sortierblatt' wird gelöscht.
Müssen 1000 Zellen miteinander verglichen werden, so sind dafür 999
Schleifendurchgänge, bzw. Vergleiche notwendig, mit dem Zusatz, das
ich mehrfach doppelte Zelle mit angezeigt bekomme und bereits einen
Hinweis erhalte wie der doppelte Eintrag aussieht.
Die Performance liegt bei 40.000 (vierzigtausend) zu vergleichenden
Zellen in Abhängigkeit vom benutzten Rechner bei ca. 15-20 sek.
Martin Beck
> Hallo Martin,
> genau das macht die verbesserte Version meines Makros vom 22.06.
Hallo Frank,
tut mir leid, aber auf meinem Newsserver war kein verbessertes Makro vom
22.6., lediglich Deine Nachricht, daß man den Cursor in A1 setzen soll. Na
ja, wenn 2 unabhängig voneinander auf die gleiche Lösung kommen, kann sie ja
nicht ganz so schlecht sein.
Gruß
Martin Beck
P.S. Danke auch an Jörg für seine Anregung.
Rainer Klueting
Arendt-Theilen) wrote:
>>Allerdings habe ich bei vielen ähnlichen Problemstellungen bislang auch
>>nichts Besseres gefunden. Die Performance läßt aber mitunter durch
>>Sortierung der Daten verbessern.
Hallo, Laufzeitfreaks ;-),
was haltet Ihr von folgender Lösung? Bei mir ist sie im direkten
Wettrennen mit der von Frank Sieger, wenn man nur die Zeit bis zum
Fehler mißt. Dann allerdings braucht sie nochmal etwa genauso lange
zum Aufräumen, was lästig ist.
Frank, Deine Lösung versagt übrigens, wenn die letzte Zeile des
Blattes erreicht wird (wegen lngI + 1, was dann nicht geht).
Der Trick bei meinem Makro: Ich verzichte ganz auf das Sortieren. Ich
füge einfach für jede Zelle eine 1 in eine Collection ein und nehme
den Inhalt der Zelle als Key. Da kein Key doppelt auftreten darf, gibt
es bei einem Doppeleintrag einen Laufzeitfehler, den ich abfange.
Sub DoppelteEintraegeFinden()
Dim c As New Collection
Dim Start As Date
Dim z As Range
Start = Now
On Error GoTo Doppel
For Each z In Selection
c.Add 1, CStr(z.Value)
Next z
MsgBox "Keine Doppeleinträge. Laufzeit: " & _
Format(Now - Start, "h:mm:ss")
Exit Sub
Doppel:
MsgBox "Doppelter Eintrag in Zelle " & z.Address & vbNewLine & _
"Laufzeit: " & Format(Now - Start, "h:mm:ss")
End Sub
Gruß
Rainer Klüting, Stuttgart