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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen