Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

ListBox füllen ohne additem

Betrifft: ListBox füllen ohne additem von: René
Geschrieben am: 09.09.2020 13:18:51

Hallo zusammen,

nachdem ich hier schon eine Weile mitgelesen und dabei viel gelernt habe (großen Dank dafür an alle Beteiligten!), stehe ich nun vor einem Problem, welches ich nicht selbst lösen kann.

Ich habe eine Liste mit einem Artikelstamm, zu welchem ich eine Artikelauswahl per UserForm kreiert habe. In der Userform sind 2 Textfelder (für die Eingabe der Artikelnummer bzw. der Artikelbezeichnung) und eine Listbox mit 2 Spalten, in welche die Ergebnisse für die Eintragung in eines der Textfelder aufgeführt werden (siehe Anlage).

Bei Änderungen in einer der Textboxen werden die zur Eingabe passenden Ergebnisse in der Listbox aktualisiert. Das funktioniert problemlos, allerdings beläuft sich der Artikelstamm bislang auf 8500 Zeilen und ist noch nicht einmal vollständig. Im Ergebnis führt das dazu, dass die Aktualisierung der Listbox recht langsam ist, da hier über AddItem gefüllt wird.

  • Private Sub eingabe_change()
    Dim LoI As Long
    Dim lozeile As Long
    Dim loLetzte As Long
    Application.ScreenUpdating = False
    
    On Error GoTo errorhandler
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Materialanforderung")
    Set stamm = wb.Sheets("Artikelstamm")
    
    ws.Activate
    
    loLetzte = IIf(IsEmpty(stamm.Cells(stamm.Rows.Count, 2)), stamm.Cells(stamm.Rows.Count, 2).End(  _
     _
    xlUp).Row, stamm.Rows.Count)
    
    Auswahl.Clear
    
    If Eingabe = "" Then
        For LoI = 2 To loLetzte
        Auswahl.AddItem stamm.Cells(LoI, 1)
        Auswahl.List(Auswahl.ListCount - 1, 1) = stamm.Cells(LoI, 2)
        Next
    Else
        Auswahl.Clear
        For LoI = 2 To loLetzte
            If Not stamm.Range(stamm.Cells(LoI, 2), stamm.Cells(LoI, 2)).Find(Eingabe, LookIn:= _
            xlFormulas, lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False) Is Nothing Then
                Auswahl.AddItem stamm.Cells(LoI, 1)
                Auswahl.List(Auswahl.ListCount - 1, 1) = stamm.Cells(LoI, 2)
            End If
        Next
    End If
    'Set artFound = Nothing
    Application.ScreenUpdating = True
    
    GoTo ende
    
    errorhandler:
    MsgBox Err.Description, vbExclamation
    
    ende:
    
    End Sub


  • Eingabe ist hierbei die TextBox für die Artikelbezeichnung.

    Wie kann ich die Prozedur beschleunigen?

    Vielen Dank im Voraus.

    PS: Ich habe mir alles, was ich über VBA weiß, selbst angeeignet (auch unter Studieren dieses Forums), daher sind meine Kenntnisse recht beschränkt.

    Mfg René

    Betrifft: AW: ListBox füllen ohne additem
    von: Daniel
    Geschrieben am: 09.09.2020 13:26:25

    Hi

    relevanten Zellbereich in eine freie Stelle auf dem Tabellenblatt oder in ein anderes Tabellenblatt kopieren.
    dort die nicht benötigten Zeilen löschen und ggf sortieren
    diesen Zellbereich komplett in die Listbox schreiben (Listbox1.List = Range(…).value)

    Gruß Daniel

    Betrifft: AW: ListBox füllen ohne additem
    von: René
    Geschrieben am: 09.09.2020 13:40:20

    Hallo Daniel,

    das habe ich auch schon versucht. Allerdings muss dieser Vorgang bei jeder Änderung im Testfeld ausgeführt werden, so das bei jedem Tastendruck die For-Schleife über die 8500 Zeilen läuft, die zutreffenden Werte kopiert und woanders eingefügt werden müssen. Danach muss ich ja (da mehrspaltige Listbox) die neuen Werte trotzdem noch per AddItem in die Listbox bringen. Nach meinen Versuchen dauert das noch deutlich länger...

    Mfg René

    Betrifft: AW: ListBox füllen ohne additem
    von: Daniel
    Geschrieben am: 09.09.2020 13:48:18

    das Bereinigen des Zellbereichs macht man auch nicht per Schleife, sondern mit anderen Methoden, die dir Excel bereit stellt und die wesentlich schneller sind.
    Beispielsweise Erweiterter (Spezial-) Filter oder Duplikate Entfernen.

    und wie gesagt, wenn der Zellbereich bereinigt ist und vollständig übernommen werden kann, brauchst du kein AddItem um die Listbox zu befüllen. du kannst den Zellbereich direkt in die Listbox schreiben (hatte ich aber geschrieben)

    Gruß Daniel

    Betrifft: AW: ListBox füllen ohne additem
    von: René
    Geschrieben am: 09.09.2020 14:04:36

    Hallo Daniel,

    erstmal danke für Deine Antworten.

    Allerdings weiß ich nicht, ob wir da aneinander vorbeireden. Das "Bereinigen" der Datensätze basiert auf der Eingabe in der TextBox, so dass in der Listbox nur die zur (Teil)-Eingabe passenden Artikel auftauchen. Anbei 2 Screenshots, einmal im "Urzustand", einmal mit Teileingabe.




    Wie soll der Spezialfilter die Eingaben aus der TextBox verarbeiten?

    Zudem kenne ich noch keinen Weg, eine mehrspaltige Listbox ohne AddItem für die erste Spalte zu befüllen...

    Mfg René

    Betrifft: AW: ListBox füllen ohne additem
    von: Daniel
    Geschrieben am: 09.09.2020 14:34:47

    Hi
    wir reden nicht aneinander vorbei.
    du verstehst mich nur noch nicht.

    Das filtern einer Tabelle über den Spezialfilter dauert bei weniger als 10000 Zeilen c.a 1/10 sec.
    dann dann kannst du die gefilterte Tabelle in einem Schritt in die Listbox überführen.

    ich würde aber die Listbox nicht permanent im Change-Event der TextBox filtern, sondern erst auf Anfrage über einen seperaten Button. Dann werden spürbare Laufzeiten nicht als störend empfunden.

    wenn du permanent neu filterst, musst du mit dem Filtern schneller sein als der Kollege schreiben kann, das dürfte schwierig werden.

    Gruß Daniel

    Betrifft: AW: ListBox füllen ohne additem
    von: Rudi Maintaire
    Geschrieben am: 09.09.2020 14:14:28

    Hallo,
    ungetestet:
    Private Sub eingabe_change()
      Dim LoI As Long
      Dim lozeile As Long
      Dim loLetzte As Long
      Dim wb As Workbook, ws As Worksheet, stamm As Worksheet, rStamm As Range
      Application.ScreenUpdating = False
      
      On Error GoTo errorhandler
      
      Set wb = ThisWorkbook
      Set ws = wb.Sheets("Materialanforderung")
      Set stamm = wb.Sheets("Artikelstamm")
      
      ws.Activate
      
      With stamm
        loLetzte = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
    Count)
        Set rStamm = .Range(.Cells(2, 1), .Cells(loLetzte, 2))
      End With
      
      If eingabe = "" Then
        auswahl.List = getList("*", rStamm)
      Else
        auswahl.List = getList("*" & eingabe.Value & "*", rStamm)
      End If
      
      'Set artFound = Nothing
      Application.ScreenUpdating = True
      
      GoTo ende
      
    errorhandler:
      MsgBox Err.Description, vbExclamation
      
    ende:
      
    End Sub
       
       Function getList(strMatch As String, rng As Range)
        Dim objLIST As Object, oObj, i As Long, arrIN, arrOUT()
        arrIN = rng.Value
        Set objLIST = CreateObject("scripting.dictionary")
        
        For i = 1 To UBound(arrIN)
          If LCase(arrIN(i, 1)) Like LCase(strMatch) Then
            objLIST(objLIST.Count + 1) = Array(arrIN(i, 1), arrIN(i, 2))
          End If
        Next i
        
        ReDim arrOUT(1 To objLIST.Count, 1 To 2)
        i = 0
        For Each oObj In objLIST
          i = i + 1
          arrOUT(i, 1) = objLIST(oObj)(0)
          arrOUT(i, 2) = objLIST(oObj)(1)
        Next oObj
        getList = arrOUT
          
       End Function
    
    

    Gruß
    Rudi

    Betrifft: AW: ListBox füllen ohne additem
    von: René
    Geschrieben am: 09.09.2020 15:06:18

    Hallo ihr drei,

    vielen Dank für die unfassbar schnellen und umfassenden Rückmeldungen.

    @Daniel:
    Die Aktualisierung während der Eingabe ist erwünscht, da man so die Ergebnisse in Echtzeit sieht. Ist vor allem schön, wenn man die exakten Bezeichnungen nicht im Kopf hat. Trotzdem danke für die Anregung, kann ich vielleicht an anderer Stelle auch gut gebrauchen.

    @Nepomuk:
    Funktioniert supi und echt schnell (ich hab noch ein UCase eingefügt), ich kann aber kein * als Platzhalter in der Eingabe verwenden (ich weiß, das war nicht die Anforderung...:-)).
    Ist aber ein extrem sparsamer Ansatz, die Übergaben von Werten als Variant habe ich noch nicht so ganz kapiert...
    Danke.

    @Rudi
    Dein Ansatz passt perfekt, danke dafür. Ich habe auch hier noch ein UCase eingefügt. Einziger Nachteil Deiner Lösung ist, dass ich nicht zu 100% verstehe, was da genau wie funktioniert...:-(

    Vielen Dank nochmal an euch, das Problem ist damit schon gelöst.

    Mfg René

    Betrifft: AW: ListBox füllen ohne additem
    von: René
    Geschrieben am: 09.09.2020 15:44:09

    Hallo Rudi,

    bin grade eben auf ein kleines Problem gestoßen. Im Artikelstamm gibt es Vorzugsartikel, die mit ##V am Ende gekennzeichnet sind.

    Hier läuft die Funktion in einen Fehler (Index außerhalb des gültigen Bereichs). Kann es sein, dass die Funktion die ## als irgendein Zahlenformat definiert? Wenn ja, wie kann man das umgehen?

    Mfg René

    Betrifft: AW: ListBox füllen ohne additem
    von: Nepumuk
    Geschrieben am: 09.09.2020 14:29:21

    Hallo René,

    teste mal:

    Private Sub TextBox1_Change()
        
        Dim avntValues As Variant
        Dim ialngIndex As Long
        
        With ThisWorkbook.Worksheets("Artikelstamm")
            
            avntValues = .Range(.Cells(2, 1), .Cells(.Rows.Count, 2).End(xlUp)).Value2
            
        End With
        
        If TextBox1.TextLength = 0 Then
            
            ListBox1.List = avntValues
            
        Else
            
            With ListBox1
                
                Call .Clear
                
                For ialngIndex = LBound(avntValues, 1) To UBound(avntValues, 1)
                    
                    If InStr(1, avntValues(ialngIndex, 2), TextBox1.Text) > 0 Then
                        
                        Call .AddItem(pvargItem:=avntValues(ialngIndex, 1))
                        .List(.ListCount - 1, 1) = avntValues(ialngIndex, 2)
                        
                    End If
                Next
            End With
        End If
    End Sub

    Gruß
    Nepumuk

    Betrifft: Nachtrag
    von: Nepumuk
    Geschrieben am: 09.09.2020 14:33:11

    Hallo René,

    ändere diese Zeile:

    If InStr(1, avntValues(ialngIndex, 2), TextBox1.Text) > 0 Then

    so:

    If InStr(1, avntValues(ialngIndex, 2), TextBox1.Text, vbTextCompare) > 0 Then

    Gruß
    Nepumuk

    Beiträge aus dem Excel-Forum zum Thema "ListBox füllen ohne additem"