AW: Kopieren / Einfügen
09.05.2020 11:01:07
Marquardt
Hallo Nepumuk,
ich habe mit Hilfe des Forums eine Suchfunktion geschaffen.
Wenn ich jetzt drei Einträge angezeigt werden wird immer die letzte Eintragung übernommen. Jetzt versuche ich schon die halbe Woche die angezeigten Werte in eine andere Userform zu übernehmen. Aber leider reichen meine Kenntnisse leider nicht aus.
Hier noch einmal die Suchfunktion. Dabei hat mir aber Marin zu 100% geholfen!!
Private Sub CommandButton11_Click()
Dim zelle As Range
Dim strZelle As String
Dim arrData As Variant, arrTmp As Variant
Dim j As Integer
With ListBox1
'ListBox leeren
.Clear
'Anzahl der angezeigten ListBox-Spalten festlegen
.ColumnCount = 15
'ListBox-Spaltenbreiten definieren
.ColumnWidths = "0 Pt;40 Pt;250 Pt;0 Pt;0 Pt;0 Pt;0 Pt;100 Pt;0 Pt;0 Pt;1000 Pt;0 Pt;0 _
Pt;0 Pt;0 Pt;0 Pt"
End With
Sheets("ME").Select
With Range("b2:b10000" & Range("b6020").End(xlUp).Row)
Set zelle = .Find(TextBox1.Value, LookIn:=xlValues)
If Not zelle Is Nothing Then
strZelle = zelle.Address
Do
'Array dimensionieren
If Not IsArray(arrData) Then
'1. Treffer
ReDim arrData(1 To 15, 1 To 1)
Else
'ab 2. Treffer
ReDim Preserve arrData(1 To 15, 1 To UBound(arrData, 2) + 1)
End If
'Spaltendaten der Zeile in Array übertragen
For j = 1 To 15
arrData(j, UBound(arrData, 2)) = Cells(zelle.Row, j)
Next j
Set zelle = .FindNext(zelle)
Loop While zelle.Address strZelle
End If
End With
'Array transponiert an ListBox übergeben, wenn Daten vorhanden
If IsArray(arrData) Then
If UBound(arrData, 2) = 1 Then
ReDim arrTmp(1 To 1, 1 To 15)
For j = 1 To 15
arrTmp(1, j) = arrData(j, 1)
Next
ListBox1.List = arrTmp
Else
ListBox1.List = Application.Transpose(arrData)
End If
End If
End Sub