hier eine Variant. Additem kann nur 10 Spalten verarbeiten, deshalb habe ich auf .List umgestellt. Ich nutze zwei Arrays um die Daten aus der Tabelle zu holen und um die passenden Ergebnisse aufzufangen. Diese werden dann in die Liste übergeben. Ich gehe davon aus das du das Suchwort in Spalte O, der letzten Spalte des Suchbereiches suchst. In deiner Beschreibung liest es sich aber so das das Suchwort in allen Spalten vorkommen kann. Aber das mußt du erst mal aufklären.
Sub arr()
Dim Suchbefehl As String
Dim lngTmpZ As Long, lngZeileMax As Long
Dim lngZeile As Long, lngSpalte As Long
Dim arrData, arrtmp
Suchbefehl = ActiveSheet.Range("F2").Value
With Me.ListBox1
.ColumnCount = 15
.ColumnWidths = "120;120;120;120;120;120;120;120;120;120;120;120;120;120;120"
.Font.Size = 14
End With
With Workbooks("Aktuelle Aufträge").Worksheets("Adressen")
lngZeileMax = .Range("A" & .Rows.Count).End(xlUp).Row 'Letzte Zeile
arrData = .Range("A7:O" & lngZeileMax).Value
ReDim arrtmp(1 To UBound(arrData), 1 To UBound(arrData, 2))
For lngZeile = LBound(arrData) To UBound(arrData)
'Startzeile bis Endzeile
If LCase(arrData(lngZeile, 2)) Like "*" & LCase(Suchbefehl) & "*" Then
lngTmpZ = lngTmpZ + 1
For lngSpalte = 1 To UBound(arrData, 2)
arrtmp(lngTmpZ, lngSpalte) = arrData(lngZeile, lngSpalte)
Next
End If
Next lngZeile
arrtmp = Application.Transpose(arrtmp)
ReDim Preserve arrtmp(1 To UBound(arrData, 2), 1 To lngTmpZ)
ListBox1.List = Application.Transpose(arrtmp)
End With
End Sub
|