ListBox füllen ohne additem

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é

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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é

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

107 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

ListBox füllen ohne additem

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

107 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread