Userform langsam

Hallo
In der Userform 2 wird gesucht was auch gut funktioniert aber leider zu langsam.
Das öffnen dauert fast 5sec und bei der suche im Textfeld lagt es total.
In der abgespeckten Version merkt man es nicht aber bei 3000 Datensätzen sehr wohl.
Abgespeckte Version ist blitzschnell
https://www.herber.de/bbs/user/148867.xlsm
Frage :
Irgendwo ist ein kleiner Fehler im VBA Code aber wo genau?
Ich vermute hier in diesemCode Teil.
If Ftext = "" Or InStr(1, W.Cells(i, 1) & W.Cells(i, 2) & W.Cells(i, 3) & W.Cells(i, 6) & W.Cells(i, 7) & W.Cells(i, 8), Ftext, _
vbTextCompare) Then
With Me.Lst_Treffer
.AddItem CStr(W.Cells(i, 1))
.List(.ListCount - 1, 1) = CStr(W.Cells(i, 2))
.List(.ListCount - 1, 3) = CStr(W.Cells(i, 3))
.List(.ListCount - 1, 4) = CStr(W.Cells(i, 4))
.List(.ListCount - 1, 6) = CStr(W.Cells(i, 6))
.List(.ListCount - 1, 7) = CStr(W.Cells(i, 7))
.List(.ListCount - 1, 8) = CStr(W.Cells(i, 8))
Danke
Gruß
Oraculix

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Befüllung der LST_Treffer Listbox Private Sub Lst_Treffer_befüllen(Optional ByVal Ftext As String = vbNullString) Dim lngRow As Long, ialngIndex As Long Dim astrValues() As String With Worksheets("FilmDb") For lngRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row If Ftext = vbNullString Or InStr(1, .Cells(lngRow, 1).Value & .Cells(lngRow, 2).Value & .Cells(lngRow, 3).Value & _ .Cells(lngRow, 6).Value & .Cells(lngRow, 7).Value & .Cells(lngRow, 8).Value, Ftext, vbTextCompare) > 0 Then ReDim Preserve astrValues(6, ialngIndex) astrValues(0, ialngIndex) = .Cells(lngRow, 1).Value astrValues(1, ialngIndex) = .Cells(lngRow, 2).Value astrValues(2, ialngIndex) = .Cells(lngRow, 3).Value astrValues(3, ialngIndex) = .Cells(lngRow, 4).Value astrValues(4, ialngIndex) = .Cells(lngRow, 6).Value astrValues(5, ialngIndex) = .Cells(lngRow, 7).Value astrValues(6, ialngIndex) = .Cells(lngRow, 8).Value ialngIndex = ialngIndex + 1 End If Next End With If ialngIndex > 0 Then Lst_Treffer.Column = astrValues Else Call Lst_Treffer.Clear End If End Sub

Hallo,


Es lagt zwar noch ein bisschen

Dann teste mal das:


'Befüllung der LST_Treffer Listbox
Private Sub Lst_Treffer_befüllen(Optional ByVal Ftext As String = vbNullString)
Dim lngRow As Long, ialngIndex As Long
Dim avntValus As Variant
Dim astrValues() As String
With Worksheets("FilmDb")
avntValus = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 8)).Value
For lngRow = LBound(avntValus, 1) To UBound(avntValus, 1)
If Ftext = vbNullString Or InStr(1, avntValus(lngRow, 1) & avntValus(lngRow, 2) & avntValus(lngRow, 3) & _
avntValus(lngRow, 6) & avntValus(lngRow, 7) & avntValus(lngRow, 8), Ftext, vbTextCompare) > 0 Then
ReDim Preserve astrValues(6, ialngIndex)
astrValues(0, ialngIndex) = avntValus(lngRow, 1)
astrValues(1, ialngIndex) = avntValus(lngRow, 2)
astrValues(2, ialngIndex) = avntValus(lngRow, 3)
astrValues(3, ialngIndex) = avntValus(lngRow, 4)
astrValues(4, ialngIndex) = avntValus(lngRow, 6)
astrValues(5, ialngIndex) = avntValus(lngRow, 7)
astrValues(6, ialngIndex) = avntValus(lngRow, 8)
ialngIndex = ialngIndex + 1
End If
Next
End With
If ialngIndex > 0 Then
Lst_Treffer.Column = astrValues
Else
Call Lst_Treffer.Clear
End If
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Userform langsam

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread