Spaltenbreite in Listbox
19.01.2004 16:57:11
J.Henseler
trotz umfangreicher Recherche und diverser eigener Versuche möchte ich euch letztendlich um Hilfe bitten.
Ich fülle eine Listbox automatisch mit dem Inhalt einer Tabelle, die ich vorher noch auswählen kann. Nun sind jedoch die Spaltenbreiten der 3 Tabellen unterschiedlich. Gibt es eine Möglichkeit, die Spaltenbreiten der Listbox automatisch anzupassen / zu definieren ? Wenn ich die Spaltenbreiten über Columnwidths manuell definiere passt diese zwar für eine Tabelle, ist aber für die anderen Tabellen zu unübersichtlich.
Außerdem die Frage: Wie kann ich in der Listbox nur die nicht leeren Spalten eines Bereichs anzeigen lassen ?
Private Sub UserForm_Initialize()
Dim Found As Range
Dim FirstAddress As String
Dim Search As String
Dim LoLetzte As Long
Dim LoI As Long
Dim ZuDurchsuchendesBlatt As Variant
Dim ZuDurchsuchendeSpalte As Variant
Dim Suchbeginn As Variant, Suchbereich As Variant, Suchende As Variant
ZuDurchsuchendesBlatt = UserForm3.ComboBox1.Value
ZuDurchsuchendeSpalte = Application.WorksheetFunction _
.Match(UserForm3.ComboBox2.Value, Sheets(ZuDurchsuchendesBlatt).Range("2:2"), 0)
Suchende = Chr(ZuDurchsuchendeSpalte + 64) & 65536
If ["Suchende"] = "" Then
LoLetzte = ["Suchende"].End(xlUp).Row
Else
LoLetzte = 65536
End If
Suchbereich = Chr(ZuDurchsuchendeSpalte + 64) & 3 & ":" & Chr(ZuDurchsuchendeSpalte + 64) & LoLetzte
Suchbeginn = Chr(ZuDurchsuchendeSpalte + 64) & 3
Search = UserForm3.TextBox1.Value
If Search = "" Then Exit Sub
With ListBox1
.ColumnWidths = " ????? "
End With
With Sheets(ZuDurchsuchendesBlatt).Range(Suchbereich)
Set Found = .Find(Search, Sheets(ZuDurchsuchendesBlatt).Range(Suchbeginn), , xlPart, , xlNext)
If Found Is Nothing Then Exit Sub
FirstAddress = Found.Address
ListBox1.AddItem Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 2)
ListBox1.List(LoI, 1) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 3)
ListBox1.List(LoI, 2) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 4)
ListBox1.List(LoI, 3) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 5)
ListBox1.List(LoI, 4) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 6)
ListBox1.List(LoI, 5) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 7)
ListBox1.List(LoI, 6) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 8)
ListBox1.List(LoI, 7) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 9)
ListBox1.List(LoI, 8) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 10)
ListBox1.List(LoI, 9) = Found.Row
LoI = LoI + 1
Do
Set Found = .FindNext(Found)
If Found.Address = FirstAddress Then Exit Sub
ListBox1.AddItem Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 2)
ListBox1.List(LoI, 1) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 3)
ListBox1.List(LoI, 2) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 4)
ListBox1.List(LoI, 3) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 5)
ListBox1.List(LoI, 4) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 6)
ListBox1.List(LoI, 5) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 7)
ListBox1.List(LoI, 6) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 8)
ListBox1.List(LoI, 7) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 9)
ListBox1.List(LoI, 8) = Sheets(ZuDurchsuchendesBlatt).Cells(Found.Row, 10)
ListBox1.List(LoI, 9) = Found.Row
If Found.Row = LoLetzte Then Exit Sub
LoI = LoI + 1
Loop While Not Found Is Nothing
End With
End Sub
Ich hoffe, ihr könnt mir mit einem Lösungsansatz weiterhelfen oder mich zumindest auf die richtige Spur bringen.
MFG
Jörg