wie kann ich einen Begriff in einer Listbox finden und den entsprechenden Listboxeintrag markieren?
Gruß
otto
Private Sub UserForm_Initialize()
Dim arr() As Variant, Tmp As Variant, wks As Worksheet
Dim index As Integer
Dim X, iCount As Long
'Auswahlliste für Combobox1 erstellen
Set wks = Sheets("Auftrag")
X = wks.Range("A65536").End(xlUp).Row
Tmp = wks.Range("A11:AB" & X)
X = X - 10
If ComboBox1 = "" Then
On Error GoTo weiter
ReDim arr(0 To 13, 0 To X - 1)
For index = 1 To UBound(Tmp, 1)
arr(iCount, 0) = Tmp(index, 1)
arr(iCount, 1) = Tmp(index, 3)
arr(iCount, 2) = Tmp(index, 4)
arr(iCount, 3) = Tmp(index, 5)
arr(iCount, 4) = Tmp(index, 6)
arr(iCount, 5) = Tmp(index, 7)
arr(iCount, 6) = Tmp(index, 8)
arr(iCount, 7) = Tmp(index, 9)
arr(iCount, 8) = Tmp(index, 10)
arr(iCount, 9) = Tmp(index, 11)
arr(iCount, 10) = Tmp(index, 12)
arr(iCount, 11) = Tmp(index, 25)
arr(iCount, 12) = Tmp(index, 26)
arr(iCount, 13) = Tmp(index, 27)
iCount = iCount + 1
Next
' arr = WorksheetFunction.Transpose(arr) ' überflüssig
Me.ComboBox1.List = arr
' Einstellungen zum Testen
Me.ComboBox1.ColumnCount = 14
Me.ComboBox1.BoundColumn = 1
Me.ComboBox1.Width = 50
Me.ComboBox1.ListWidth = 450
Me.ComboBox1.ColumnWidths = "40Pt;30Pt;30Pt;30Pt;30Pt;30Pt;30Pt;30Pt;30Pt;30Pt;30Pt;30Pt;30Pt;30Pt"
'StartWert für Combobox setzen
Me.ComboBox1.Value = "A5"
End If
weiter:
End Sub
Private Sub ComboBox1_Change()
Dim arr() As Variant, Tmp As Variant, wks As Worksheet
Dim index As Integer
Dim X, iCount
Set wks = Sheets("Auftrag")
X = wks.Range("A65536").End(xlUp).Row
Tmp = wks.Range("A11:AB" & 11 + X)
X = X - 10
If ComboBox1 = "" Then
On Error GoTo weiter
ReDim arr(0 To 13, 0 To X - 1)
For index = 1 To UBound(Tmp, 1)
arr(0, iCount) = Tmp(index, 1)
arr(1, iCount) = Tmp(index, 3)
arr(2, iCount) = Tmp(index, 4)
arr(3, iCount) = Tmp(index, 5)
arr(4, iCount) = Tmp(index, 6)
arr(5, iCount) = Tmp(index, 7)
arr(6, iCount) = Tmp(index, 8)
arr(7, iCount) = Tmp(index, 9)
arr(8, iCount) = Tmp(index, 10)
arr(9, iCount) = Tmp(index, 11)
arr(10, iCount) = Tmp(index, 12)
arr(11, iCount) = Tmp(index, 25)
arr(12, iCount) = Tmp(index, 26)
arr(13, iCount) = Tmp(index, 27)
Next
arr = WorksheetFunction.Transpose(arr)
weiter:
Kundenauftrag.ListBox1.List = arr
Else
For index = 1 To UBound(Tmp, 1)
If LCase(Left(Tmp(index, 1), Len(ComboBox1))) = LCase(ComboBox1) Then
ReDim Preserve arr(0 To 13, 0 To iCount)
arr(0, iCount) = Tmp(index, 1)
arr(1, iCount) = Tmp(index, 3)
arr(2, iCount) = Tmp(index, 4)
arr(3, iCount) = Tmp(index, 5)
arr(4, iCount) = Tmp(index, 6)
arr(5, iCount) = Tmp(index, 7)
arr(6, iCount) = Tmp(index, 8)
arr(7, iCount) = Tmp(index, 9)
arr(8, iCount) = Tmp(index, 10)
arr(9, iCount) = Tmp(index, 11)
arr(10, iCount) = Tmp(index, 12)
arr(11, iCount) = Tmp(index, 25)
arr(12, iCount) = Tmp(index, 26)
arr(13, iCount) = Tmp(index, 27)
iCount = iCount + 1
End If
Next
End If
If iCount <> 0 Then
On Error GoTo ende
ListBox1.Column = arr
End If
ListBox1.ColumnWidths = "80;65;55;20;60;20;100;70;40;40;35;80;40;70"
LabelMeldung.Caption = iCount & " Einträge"
ende:
End Sub
If iCount <> 0 Then
On Error GoTo ende
ListBox1.Column = arr
End If
ListBox1.ColumnWidths = "80;65;55;20;60;20;100;70;40;40;35;80;40;70"
LabelMeldung.Caption = iCount & " Einträge"
Me.ListBox1.Value = Me.ComboBox1.Value
Exit Sub
ende:
MsgBox "Fehler ist aufgetreten beim Erstellen der Auswahlliste"
End Sub