AW: Durch Checkbox soll Listbox gefüllt werden
13.07.2019 19:59:45
Sören
Hallo Werner,
tut mir leid für die späte Antwort. Bin gerade aus nem kurz Urlaub zurück. Leider bekomme ich die Datei nicht hochgeladen. Deswegen wollte ich dir den Code zeigen, weshlab die Fehlermeldung 2110 kommt. Vielleicht erkennst du daran, weshalb die Fehlermeldung kommt.
Private Sub Suchen_Click()
Dim rng As Range, strFirst As String
Dim vtmp() As Long, i As Long
If Me.CheckBox2 Then
Me.StationSuche.Enabled = False
Me.ListBox1.Clear
For i = 25 To Cells(Rows.Count, "A").End(xlUp).Row
If InStr(Cells(i, "A"), "-") > 0 Then
Me.ListBox1.AddItem Cells(i, "A")
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(i, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(i, 6)
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(i, 12)
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = i
End If
Next i
Else
Me.StationSuche.Enabled = True
Me.ListBox1.Clear
If Len(Trim(StationSuche)) = 0 Then
MsgBox "Bitte geben Sie eine Station ein!", vbCritical + vbOKOnly, " Eingabefehler!"
StationSuche = ""
ListBox1.Clear
StationStart = ""
CheckBox1 = False
CheckBox2 = False
Endgeraet = ""
Endgeraeteanzahl = ""
Stationsseite = ""
StationSuche.SetFocus
Exit Sub
End If
ReDim vtmp(0)
With ActiveSheet
ListBox1.Clear
Set rng = .Range("A:C").Find(What:=StationSuche, Lookat:=xlWhole)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
ListBox1.AddItem .Cells(rng.Row, 1)
ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(rng.Row, 1)
ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(rng.Row, 6)
ListBox1.List(ListBox1.ListCount - 1, 3) = .Cells(rng.Row, 12)
ListBox1.List(ListBox1.ListCount - 1, 4) = rng.Row
End If
Set rng = .Range("A:C").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
End If
If ListBox1.ListCount > 0 Then
ListBox1.ListIndex = 0
Else
MsgBox "Die gesuchte Station " & StationSuche.Value & vbCrLf & "wurde nicht gefunden!", _
vbExclamation + vbOKOnly, "Suchassistent!"
StationSuche = ""
ListBox1.Clear
StationStart = ""
CheckBox1 = False
CheckBox2 = False
Endgeraet = ""
Endgeraeteanzahl = ""
Stationsseite = ""
StationSuche.SetFocus
End If
Set rng = Nothing
End Sub
Private Sub UserForm_Activate()
StationSuche.SetFocus
With ListBox1
.ColumnCount = 5
.ColumnWidths = "1,6cm;0,1cm;4,5cm"
End With
End Sub
Private Sub ListBox1_Click()
Dim intC As Integer, lngR As Long, ausg As Integer
With ListBox1
If .ListCount = 0 Then Exit Sub
If .List(.ListIndex, 0) = "" Then Exit Sub
lngR = CLng(.List(.ListIndex, 4))
zeile = lngR
End With
If Me.CheckBox2 Then
Me.StationStart1.Value = Cells(zeile, 1)
Me.CheckBox1 = True
Else
Me.StationStart.Value = Cells(zeile, 1)
End If
Me.Endgeraet.Value = Cells(zeile, 6)
Me.Endgeraeteanzahl.Value = Cells(zeile, 10)
Me.Stationsseite.Value = Cells(zeile, 12)
If Not Me.CheckBox2 Then
StationSuche.SetFocus
End If
End Sub
Gruß Sören