Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: per VBA doppelte Werte finden

per VBA doppelte Werte finden
16.03.2022 14:04:11
Martin
Ich habe in einer Tabelle in Spalte D Personalnummern, in Spalte E Kartennummern und in Spalte H Preise.
Jede Personalnummer darf nicht mehr als eine aktive Karte haben. Aktive Karte heisst, in Spalte H steht ein Wert größer 0
Wie kann ich in VBA einen Check durchführen, ob es Personalnummern gibt, für die mehr als eine aktive Kartennummer existiert?
Geht das irgendwie mit WorksheetFunction.CountIfs? Wäre dankbar für einen Beispiel-Code.
Oder muss ich eine for/next-Schleife machen, um für jede Zeile die Personalnummer zu nehmen und dann in einer weiteren Schleife die Tabelle einmal von oben nach unten danach zu durchsuchen, ob es Zeilen mit gleicher Personalnummer und einer anderen aktiven Kartennummmer gibt? Das kriege ich zwar hin, ist aber vermutlich sehr ineffektiv, weil bei 500 Personalnummern dann ja 500 mal die komplette Tabelle durchsucht wird.
Anzeige

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: per VBA doppelte Werte finden
16.03.2022 16:18:23
Martin
@firmus:
Danke, aber leider hilft das nicht. Die Kartennummern sind ja unterschiedlich. Wenn es für eine Personalnummer unterschiedliche Kartennummern mit einem Preis gibt, ist das Ergebnis in der Hilfsspalte E immer 1. Ich möchte es auch ohne Hilfsspalten und ausschließlich in VBA lösen.
@UweD:
Vielen Dank! Das funktionierte, nachdem ich Columns(6) durch Columns(8) (H ist der 8. Buchstabe) ersetzt habe. Es ist aber leider sehr langsam. Die Ausführung dauert fast eine halbe Minute, und Excel meldet bereits 'not responding'
Anzeige
AW: per VBA doppelte Werte finden
16.03.2022 14:26:34
UweD
Hallo
hier mal eine Möglichkeit

Sub Test()
Dim LR As Integer, i As Integer, Z1 As Integer
Z1 = 2 ' ggf wegen Überschrift
LR = Cells(Rows.Count, "D").End(xlUp).Row 'letzte Zeile der Spalte
For i = Z1 To LR
If WorksheetFunction.CountIfs(Columns(4), Cells(i, 4), Columns(6), "> 0") > 1 Then
GoTo Ende
End If
Next
MsgBox "Alles OK"
Exit Sub
Ende:
MsgBox Cells(i, 4) & " Mehrfach vorhanden."
End Sub
LG UweD
Anzeige
AW: per VBA doppelte Werte finden
16.03.2022 17:49:29
Martin
Vielen Dank! Das funktionierte, nachdem ich Columns(6) durch Columns(8) (H ist der 8. Buchstabe) ersetzt habe. Es ist aber leider sehr langsam. Die Ausführung dauert fast eine halbe Minute, und Excel meldet bereits 'not responding'. Es ist aber mit 35s zu 45 Sekunden etwas fixer als mein Versuch mit zwei verschachtelten for/next-Schleifen.
Anzeige
Wenns schnell gehen soll
16.03.2022 19:18:11
Daniel
dann probier mal diesen Code

Sub Mehrfach_Kreditkarten()
Dim dic As Object
Dim z As Long
Dim arr
Dim Erg
Dim x As Long
Set dic = CreateObject("Scripting.dictionary")
arr = Cells(1, 1).CurrentRegion
For z = 2 To UBound(arr, 2)
If arr(z, 8) > 0 Then
If dic(arr(z, 4)).exists Then
If InStr(dic(arr(z, 4)), arr(z, 5)) = 0 Then dic(arr(z, 4)) = dic(arr(z, 4)) & ";" & arr(z, 5)
Else
dic(arr(z, 4)) = arr(z, 5)
End If
End If
Next
arr = dic.Keys
ReDim Erg(1 To dic.Count, 1 To 2)
For z = 0 To UBound(arr)
If dic(arr(z)) Like "*;*" Then
x = x + 1
Erg(x, 1) = arr(z)
Erg(x, 2) = dic(arr(z))
End If
Next
Cells(1, Columns.Count).End(xltoleft).Offset(0, 2).Resize(UBound(Erg, 1), UBound(Erg, 2)) = Erg
End Sub
mangels Beispieldatei nicht getestet.
die Ausgabe erfolgt neben den Daten, in der ersten Spalte alle Personalnummern, die mehrere Kreditkarten verwenden und daneben die Kreditkartennummern.
Gruß Daniel
Anzeige
AW: Wenns schnell gehen soll
17.03.2022 11:34:24
Martin
Ich bekomme einen error 13 "Typen unverträglich" und die Zeile
For z = 2 To UBound(arr, 2)
ist gelb markiert
Ich habe dann das array geändert:
With Worksheets("Tabelle1")
arr = .Range("A7:N" & .Cells(.Rows.Count, 4).End(xlUp).Row)
End With
Nun kommt ein Laufzeitfehler 424 'Objekt erforderlich' und
If dic(arr(z, 4)).Exists Then
ist gelb markiert
Anzeige
AW: Wenns schnell gehen soll
17.03.2022 11:45:38
Daniel
Hi
Vermutlich beginnt deine Tabelle nicht in A1, sondern in einer anderen Zelle.
Gib hier arr = Cells(1, 1).CurrentRegion mal anstelle von Cells(1, 1) die linke obere Zelle deiner Datentabelle an.
Mach auch mal in For z = 2 To UBound(arr, 2) aus der letzten 2 eine 1
Gruß Daniel
Anzeige
AW: Wenns schnell gehen soll
17.03.2022 11:59:47
Martin
Die Tabelle beginnt in Zeile 6 mit den Überschriften der Spalten.
Spalte A ist leer.
Spalte B und C enthalten Daten, die hier nicht weiter relevant sind.
In D steht die Personal-Nr.
In E die Karten-Nr.
In H der Betrag
Spalten F bis G und I bis N enthalten Daten, die hier nicht weiter relevant sind.
Eine Ausgabe des Ergebnisses sollte möglichst in Form einer Msg-Box erfolgen. Oder in einem neuen Tabellenblatt. Das direkte reinschreiben in Spalten der Tabelle wäre problematisch. Wir können damit aber erstmal weiter testen, ich habe ab Spalte I jetzt alles frei.
Du verwendest ja im array die Spalten 4, 5 und 8, deshalb habe ich das array beginnend ab Spalte A/Zeile 7 definiert:
arr = Cells(7, 1).CurrentRegion
Mit
For z = 2 To UBound(arr, 1)
kommt der gleiche Laufzeitfehler 424 mit Vewrweis auf die gleiche Codezeile
Anzeige
und auf die Idee...
17.03.2022 12:03:27
Oberschlumpf
Martin,
...eine Bsp-Datei per Upload zu zeigen, die an den richtigen Stellen Bsp-Daten enthält, kommst du nich von allein, oder wie?
Sorry, ihr spielt bis jetzt alle nur Frage-Antwort-PingPong ohne wirklich ganz gute Ergebnisse.
Finde den Fehler...
Thorsten
AW: Wenns schnell gehen soll
17.03.2022 12:41:59
Daniel
Wie gesagt, ohne deine Datei zu kennen, ist es schwierig, passenden Code zu schreiben.
Du kannst auch deine Daten an den Code anpassen, verschieben die Tabelle einfach so, dass die Tabelle
mit der Überschrift in Zelle A1 beginnt.
Dann sollte der ursprüngliche Code passen (natürlich mit Ubound(Art, 1))
Welchen Zellbereich das .CurrentRegion selektiert, kannst du selber testen in dem du die angegebene Zelle markierst und STRG+A drückst.
Dieser Zellbereich geht dann ins Array. Sollte der Zellbereich für Array nicht in A1 beginnen, müssen Zeilen- und Spaltennummern ggf angepasst werden, da die Zählung im Array immer mit 1 beginnt.
Die Ausgabe des Ergebnisses sollest du dann vielleicht auch besser auf einem anderen Blatt machen.

Sheets("Tabelle2").Cells(1, 1).resize(ubound(Erg, 1), Ubound(erg, 2)) = erg
Gruß Daniel
Anzeige
AW: Wenns schnell gehen soll
17.03.2022 13:22:51
Daniel
in welcher Zeile tritt der Fehler auf?
bitte auskunftsfreudiger sein. Da du hier nichts bezahlen musst, solltest du du dich bemühen, einem Helfer das Leben so einfach wie möglich zu machen.
korrigiert mal das 2. IF: If dic.exists(arr(z, 1)) Then
wenn du die Ergebnisse auf ein zweites Blatt schreiben willst, musst du das zweite Blatt auch anlegen.
wenn die Daten wie von mir angenommen in Zelle A1 beginnen, darfst du auch meine ursprüngliche Ausgabe verwenden, welche den freien Platz für die Ausgabe in der Zeile 1 sucht.
Gruß Daniel
Anzeige
AW: per VBA doppelte Werte finden
16.03.2022 16:45:19
Daniel
HI
ohne VBA so:
1. kopiere dir die Tabelle oder die benötigten Spalten (D, E, H) in eine andere Tabelle, mit der du arbeiten kannst.
2. lösche alle Zeilen, die in Spalte H eine 0 haben
3. führe mit der Tabelle ein DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN durch, mit Personalnummer und Kreditkartennummernspalte als Kriterium.
4. sortiere nach Personalnummer
5. lasse dir mit der Bedingten Formatierung die Duplikate in der Spalte mit den Personalnummern anzeigen (Bedingte Formatierung - Regeln zum hervorheben von Zellen - Doppelte Werte)
6. Filtere nach den Doppelten (Autofilter, nach Farbe filtern) und kopiere sie in eine neue Tabelle.
7. Entferne dort die Duplikate
dann hast du die Liste mit den Personalnummern, die mehr als eine Kreditkarte haben.
Gruß Daniel
Anzeige

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige

Infobox / Tutorial

Doppelte Werte in Excel per VBA finden und bearbeiten


Schritt-für-Schritt-Anleitung

Um doppelte Werte in Excel mithilfe von VBA zu finden, kannst du den folgenden Beispiel-Code verwenden. Dieser Code prüft, ob es für eine Personalnummer mehr als eine aktive Kartennummer gibt:

Sub Test()
    Dim LR As Integer, i As Integer
    Z1 = 2 ' ggf wegen Überschrift
    LR = Cells(Rows.Count, "D").End(xlUp).Row ' letzte Zeile der Spalte
    For i = Z1 To LR
        If WorksheetFunction.CountIfs(Columns(4), Cells(i, 4), Columns(8), "> 0") > 1 Then
            MsgBox Cells(i, 4) & " hat mehrere aktive Karten."
            Exit Sub
        End If
    Next
    MsgBox "Alles OK"
End Sub

In diesem Beispiel wird die CountIfs-Funktion verwendet, um die Personalnummern in Spalte D und die Preise in Spalte H zu überprüfen. Achte darauf, dass die Spalten an deine Datenstruktur angepasst sind.


Häufige Fehler und Lösungen

  • Laufzeitfehler 424 "Objekt erforderlich": Dieser Fehler tritt häufig auf, wenn du auf eine nicht existierende Zelle oder ein nicht korrekt definiertes Objekt zugreifen möchtest. Stelle sicher, dass die Range korrekt angegeben ist.

  • Excel not responding: Wenn dein Code zu lange dauert, kann Excel „not responding“ anzeigen. Überlege, ob du die Schleifen optimieren oder die Anzahl der durchsuchten Zeilen reduzieren kannst.

  • Typen unverträglich: Überprüfe, ob die zu vergleichenden Werte tatsächlich vom gleichen Datentyp sind. Stelle sicher, dass du keine String- und Integer-Werte vermischst.


Alternative Methoden

Wenn du keine VBA-Lösungen verwenden möchtest, kannst du auch die integrierten Excel-Funktionen nutzen:

  1. Kopiere die benötigten Spalten in ein neues Arbeitsblatt.
  2. Lösche alle Zeilen mit einem Wert von 0 in der relevanten Spalte.
  3. Verwende Daten - Datentools - Duplikate entfernen, um die doppelten Einträge zu identifizieren.
  4. Setze eine bedingte Formatierung ein, um die doppelten Werte farblich hervorzuheben.

Praktische Beispiele

Hier ist ein einfaches Beispiel, um doppelte Werte in einer Liste zu finden:

Sub Mehrfach_Kreditkarten()
    Dim dic As Object
    Dim z As Long
    Dim arr
    Set dic = CreateObject("Scripting.dictionary")
    arr = Cells(1, 1).CurrentRegion
    For z = 2 To UBound(arr, 1)
        If arr(z, 8) > 0 Then
            If Not dic.exists(arr(z, 4)) Then
                dic.Add arr(z, 4), arr(z, 5)
            Else
                dic(arr(z, 4)) = dic(arr(z, 4)) & ";" & arr(z, 5)
            End If
        End If
    Next
    ' Ausgabe in einem neuen Blatt
    Sheets("Ergebnisse").Cells(1, 1).Resize(dic.Count, 2).Value = Application.Transpose(dic.Items)
End Sub

In diesem Code wird ein Dictionary verwendet, um die Kartennummern für jede Personalnummer zu speichern.


Tipps für Profis

  • Verwende Option Explicit am Anfang deiner Module, um sicherzustellen, dass alle Variablen deklariert sind. Dies hilft, Fehler zu vermeiden.

  • Optimiere deine Schleifen, indem du die Anzahl der Durchläufe reduzierst. Beispielsweise kannst du mit Range("D2:D" & LR).SpecialCells(xlCellTypeConstants) direkt auf die relevanten Zellen zugreifen.

  • Baue Fehlerbehandlungsroutinen ein, um den Code robuster zu machen.


FAQ: Häufige Fragen

1. Wie finde ich doppelte Einträge in Excel ohne VBA?
Du kannst die Funktion „Duplikate entfernen“ unter dem Menüpunkt „Daten“ verwenden, um doppelte Werte schnell zu identifizieren und zu löschen.

2. Was tun, wenn Excel sagt "not responding"?
Reduziere die Datenmenge oder optimiere deinen VBA-Code, um die Verarbeitungsgeschwindigkeit zu erhöhen. In großen Datensätzen kann die Verwendung von Arrays die Leistung verbessern.

3. Kann ich doppelte Werte in einer bestimmten Spalte suchen?
Ja, indem du die Range und die entsprechenden Spalten im VBA-Code anpasst, kannst du gezielt nach doppelten Werten in einer bestimmten Spalte suchen.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige