Microsoft Excel

Herbers Excel/VBA-Archiv

Combobox ohne Duplikae

Betrifft: Combobox ohne Duplikae von: Frank S.
Geschrieben am: 15.09.2020 08:39:12

Guten Tag zusammen,
habe leider mal wieder eine Frage.
Ich habe auf einer UF eine Combobox, welche über eine Suchfunktion aus vielen Blättern befüllt wird.Werte kommen häufig doppelt vor. Daher habe ich einen hier im Forum gefundenen Code modifiziert und an meine Belange angepasst. Wohl nicht ganz korrekt, denn meine Box wird befüllt, aber ich habe viele, viele doppelte Werte.
Kann mir jemand sagen, wo mein Fehler liegt?

  • Sub ComboOhne()
    'Testcode Combobox sortiert ohne Doppel
        Dim objDictionary As Object
        Dim varBereich As Variant
        'Dim loZaehler As Long
        Dim arrDaten
        'Dim lngLetzte As Long
        Dim Last As Integer, i As Integer
        Dim ws As Worksheet
        Dim ws1 As Worksheet
        'lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
    Count)
        
        Set objDictionary = CreateObject("Scripting.Dictionary")
    '    With Worksheets("Tabelle1")
    '        varBereich = .Range(.Cells(2, 1), Cells(lngLetzte, 1))
    '    End With
    '    ' Schleife über alle Werte des Bereichs
    '    For loZaehler = LBound(varBereich) To UBound(varBereich)
    '        ' Eintrag wird nur übernommen wenn er im DictionaryObject noch nicht enthalten ist
    '        objDictionary(varBereich(loZaehler, 1)) = 0
    '    Next
        For Each ws In twb.Worksheets
            If ws.Name <> "Center" And ws.Name <> "Hardware" And ws.Name <> "hwvlg" And ws.Name <> " _
    data" And ws.Name <> "Druckvorlage" And ws.Name <> "Protokoll" Then
                Set ws1 = twb.Worksheets(ws.Name)
                Last = ws1.Cells(Rows.Count, 1).End(xlUp).Row
                    For i = 2 To Last
                        'If ws1.Cells(i, 3).Value <> "" Then
                            objDictionary(ws1.Cells(i, 3)) = 0
                        'End If
                    Next i
            End If
        Next
        ' Werte in ein Array übergeben
        arrDaten = objDictionary.keys
    
        ' sortieren von A nach Z
        ' Lbound kleinster Wert,UBound Größter Wert
        Sort_Z_A arrDaten, LBound(arrDaten), UBound(arrDaten)
        Me.ComboBox1.List = arrDaten
        '-------Ende-------------
        
    End Sub

  • Sortierfunktion ist als weitere
    Sub vorhanden und funktioniert ebenso.
    Der auskommentierte Code stammt vom originalem Code, den ich im folgenden angepasst habe.
    
    Viele Grüße, Frank
    
    
    

    Betrifft: AW: Combobox ohne Duplikae
    von: MRUTOR
    Geschrieben am: 15.09.2020 08:45:00

    Hallo Frank,

    ich hab jetzt nichts getestet aber hier:
    If ws.Name <> "Center" And ws.Name <> "Hardware" And ws.Name <> "hwvlg" And ws.Name <> " _
    data" And ws.Name <> "Druckvorlage" And ws.Name <> "Protokoll" Then

    ist glaub ich Or eher angebracht als And.
    Weil ein Sheet kann ja nur einen Namen haben. Vielleicht ist das schon der Grund, dass er hier nicht in die If Abfrage geht.

    Gruss Tor

    Betrifft: AW: Combobox ohne Duplikae
    von: Frank S.
    Geschrieben am: 15.09.2020 09:12:24

    Hallo Tor,
    leider hast du Unrecht. Das AND ist schon richtig. Dieser Codeteil wird an vielen anderen Stellen im gesamten Programm erfolgreich genutzt. Es dürfen diese benannten Tabellen NICHT mit überprüft/durchlaufen werden. Daher ist OR nicht möglich.

    Trotzzdem Danke.

    Betrifft: AW: Combobox ohne Duplikae
    von: Daniel
    Geschrieben am: 15.09.2020 08:54:51

    Hi

    Ausgehend von der Tatsache, dass man mit .AddItem die Daten nicht nur am Ende einfügen kann, sondern auch mitten drin an einer bestimmten Position (indexnummer mit angeben),kann man sortierte und Duplikatfreie Listen auch mit einer Simpel-Programmierung erstellen.

    Man erstellt eine Schleife vom ersten bis zum letzten Wert der Liste
    Man vergleicht den neu hinzugekommenen Eintrag mit mit dem jeweiligen List-Wert
    Ist der neue wert gleich, bricht man die Schleife ab (exit for)
    Ist der neue Wert kleiner, bricht man die Schleife ab und fügt den Wert an dieser Stelle ein.
    Wird die Schleife vollständig durchlaufen, fügt man den Wert am Ende hinzu.
    Ob eine Schleife vollständig durchlaufen wurde erkennt man daran, dass der schleifenzähler größer ist als der Endwert.

    Damit bekommt man eine sortierte duplikatfreie Liste, ohne dass man fortgeschrittene Methoden (Dictionary) oder komplexe Algorithmen (sortieren) verwenden muss.

    Gruß Daniel

    Betrifft: AW: Combobox ohne Duplikae
    von: Frank S.
    Geschrieben am: 15.09.2020 09:09:18

    Hallo Daniel,
    deine Lösung war ursprünglich auch mein erster Gedanke. Aber bei bis zu 100 Tabellenblättern und jeweile zwischen 3 und 200 Zeilen pro Seite, dachte ich, dass es dann einfach zu langsam in der Abarbeitung wird.
    Vielleicht mache ich es dann doch so mit ner Schleife. Danke für deine Antwort.

    Gruß, Frank

    Betrifft: AW: Combobox ohne Duplikae
    von: Daniel
    Geschrieben am: 15.09.2020 09:57:40

    Hi
    kannst ja mal probieren was schneller ist.
    in deinem Code selber kann ich keinen Fehler erkennen.
    da müsste man mal auf die Werte in den Tabellenblättern schauen, ob diese nicht durch anhängende Leerzeichen oder andere schwer sichtbare Sonderzeichen keine Duplikate mehr sind.


    prinzipiell ist dein Code etwas umständlich.
    du brauchst die Variable ws1 nicht, da kannst du ws weiter verwenden.
    auch die Schleife über einzelnen Zellen ist langsam. Das geht mit For-Each schneller als mit der zählschleife.

    ggf vorhandene Leerzeichen am Anfang oder Ende entfernst du mit TRIM

    mit SELECT CASE kannst du die Auswahl der Blätter etwas übersichtlicher gestalten:
    ..
    Dim Wert
    ...
    
         For Each ws In twb.Worksheets
             Select Case ws.Name 
                 case "Center", "Hardware", "hwvlg", "data",  "Druckvorlage", "Protokoll" 
                 case else
                     for each Wert in ws.Range(ws.Cells(2, 3), ws.Cells(ws.rows.count, 3).end(xlup)) _
    .Values
                         objDictionary(Trim(Wert)) = 0
                     Next 
              End Select
         Next
    

    Gruß Daniel

    Betrifft: AW: Combobox ohne Duplikae
    von: Frank S.
    Geschrieben am: 15.09.2020 10:37:53

    Ich danke euch allen,
    jetzt gehts ans Testen. Ich schließe diesen Post vorerst mal und bedanke mich bei allen für eure Hilfe und Antworten.

    Betrifft: AW: Combobox ohne Duplikae
    von: Nepumuk
    Geschrieben am: 15.09.2020 09:44:18

    Hallo Frank,

    teste mal:

    Private Sub UserForm_Initialize()
        
        Dim objArrayList As Object
        Dim avntValues As Variant, vntItem As Variant
        Dim ws As Worksheet
        
        Set objArrayList = CreateObject("System.Collections.ArrayList")
        
        For Each ws In ThisWorkbook.Worksheets
            
            If ws.Name <> "Center" And ws.Name <> "Hardware" And ws.Name <> "hwvlg" And _
                ws.Name <> "data" And ws.Name <> "Druckvorlage" And ws.Name <> "Protokoll" Then
                
                With ws
                    avntValues = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp)).Value
                End With
                
                For Each vntItem In avntValues
                    If Not IsEmpty(vntItem) Then _
                        If Not objArrayList.Contains(vntItem) Then Call objArrayList.Add(vntItem)
                Next
            End If
        Next
        
        Call objArrayList.Sort
        ComboBox1.List = objArrayList.ToArray
        Set objArrayList = Nothing
        
    End Sub

    Gruß
    Nepumuk

    Betrifft: AW: Combobox ohne Duplikae
    von: Frank S.
    Geschrieben am: 15.09.2020 09:52:10

    Hallo Nepumuk,
    das sieht super aus. Brauche nur gerade etwas Zeit zum Testen (mache ich nebenbei während der Arbeit).
    Bis später und Danke.

    Betrifft: AW: Combobox ohne Duplikae
    von: Frank S.
    Geschrieben am: 16.09.2020 15:04:18

    Hallo Daniel und Hallo Nepumuk.
    Dank eurer Hilfe läuft meine Routine nun wie ich es wollte. Rein zur Info für euch, ich habe das beste aus beiden Codebeispielen von euch verwendet.
    Nepumuk, dein Code rannte leider am Ende beim Code "ComboBox1.List = objArrayList.ToArray" in einen Fehler. Methode unbekannt.
    Daniel, dein Code, etwas umgebaut) hat besser funktioniert. Leider konnte ich auf die Last-Variable nicht verzichten, denn dein Code produziert immer dann einen Fehler, wenn in einem Blatt außer der Überschrift (Zeile 1) keine Werte sind. Habe dann mit diversen Änderungen experimentiert, Fehler blieb. Bin dann wieder auf meine umständliche Variante mit der Last-Variable zurück und da läuft es.
    Hier mein lauffähiger Code:
    Dim objDictionary As Object
        Dim arrDaten
        Dim Last As Integer, i As Integer
        Dim ws As Worksheet
        Dim Wert As Variant
        
        Set objDictionary = CreateObject("Scripting.Dictionary")
        For Each ws In twb.Worksheets
            'Debug.Print ws.Name
            Select Case ws.Name
                Case "Center", "Hardware", "hwvlg", "data", "Druckvorlage", "Protokoll"
                Case Else
                    Last = ws.Cells(Rows.Count, 1).End(xlUp).Row
                    For i = 2 To Last
                        Wert = ws.Cells(i, 3).Value
                        If Last >= 2 And Wert <> "" And ws.Cells(i, 2).Value = 2 Then
                            'Debug.Print Wert
                            objDictionary(Wert) = 0
                        End If
                    Next
            End Select
        Next
        ' Werte in ein Array übergeben
        arrDaten = objDictionary.keys
        Sort_Z_A arrDaten, LBound(arrDaten), UBound(arrDaten)
        Me.cbVST.List = arrDaten
    Einen schönen Wochenteiler euch beiden.
    Gruß, Frank

    Beiträge aus dem Excel-Forum zum Thema "Combobox ohne Duplikae"