ich bin gerade dabei, meine bestehende UF Eingabemaske durch eine Suchfunktion zu erweitern. Ich bekomme aber immer wieder die Fehlermeldung Laufzeitfehler 9 Index außerhalb des gültigen Bereichs angezeigt.
Private Sub CommandButton4_Click()
Dim objCell As Range
Dim strFirstAddress As String
Dim lngRow As Long, lngCount As Long
Dim objDictionary As Object
Call ListBox1.Clear
If TextBox13.TextLength = 0 Then
Call MsgBox("Bitte einen Suchbegriff eingeben.", vbExclamation, "Hinweis")
Else
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
With Worksheets("Datenbank")
Set objCell = .Cells.Find(What:=TextBox13.Text, After:=Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not objCell Is Nothing Then
strFirstAddress = objCell.Address
Do
lngRow = objCell.Row
If Not objDictionary.Exists(lngRow) Then
objDictionary(lngRow) = vbNullString
Call ListBox1.AddItem
ListBox1.List(lngCount, 0) = .Cells(lngRow, 8).Text
ListBox1.List(lngCount, 1) = .Cells(lngRow, 1).Text
ListBox1.List(lngCount, 2) = .Cells(lngRow, 2).Text
ListBox1.List(lngCount, 3) = .Cells(lngRow, 13).Text
ListBox1.List(lngCount, 4) = .Cells(lngRow, 14).Text
ListBox1.List(lngCount, 5) = .Cells(lngRow, 15).Text
ListBox1.List(lngCount, 6) = .Cells(lngRow, 18).Text
ListBox1.List(lngCount, 7) = .Cells(lngRow, 19).Text
ListBox1.List(lngCount, 8) = CStr(lngRow)
lngCount = lngCount + 1
End If
Set objCell = .Cells.FindNext(After:=objCell)
Loop Until objCell.Address = strFirstAddress
Set objCell = Nothing
Else
Call MsgBox("Es wurde nichts gefunden.", vbExclamation, "Hinweis")
End If
End With
End If
End Sub
Grüße Kuni