AW: Listbox mit Werten und tausender Punkt
06.11.2021 11:33:25
Werner
Hallo,
mit Schleife über die entsprechenden Spalten in der Hilfstabelle und die Werte in Text umwandeln.
Private Sub TextBox1_AfterUpdate()
Dim loLetzte As Long, i As Long, raListe As Range, raZelle As Range
With Worksheets("Daten")
If Me.TextBox1 "" Then
If WorksheetFunction.CountIf(.Columns("C"), Me.TextBox1) > 0 Then
loLetzte = .Columns("C").Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlPrevious).Row
For i = 2 To loLetzte
If .Cells(i, "C") = Me.TextBox1 Then
If raListe Is Nothing Then
Set raListe = .Cells(i, "A").Resize(, 12)
Else
Set raListe = Union(raListe, .Cells(i, "A").Resize(, 12))
End If
End If
Next i
If Not raListe Is Nothing Then
With Worksheets("Hilfstabelle")
.Range("A1").CurrentRegion.Clear
raListe.Copy .Range("A1")
For Each raZelle In .Range("G1:I" & .Cells(.Rows.Count, "A").End(xlUp).Row)
raZelle.Value = raZelle.Text
Next raZelle
Me.ListBox1.TextAlign = fmTextAlignRight
Me.ListBox1.ColumnCount = 12
Me.ListBox1.ColumnWidths = "2 cm;2 cm;2 cm;2 cm;2 cm;2 cm;3 cm;3 cm;3 cm;2 cm"
Me.ListBox1.Clear
Me.ListBox1.List = .Range("A1").CurrentRegion.Value
End With
End If
Else
MsgBox "Suchbegriff " & Me.TextBox1 & " ist in Spalte C nicht vorhanden."
End If
End If
End With
Set raListe = Nothing
End Sub
Gruß Werner