16.07.2018, 20:27
Hi jokerjo1000,
hier die gewünscht Anpassung für die UF2.
Für die Listbox im Eigenschaftenfenster diese Werte eintragen.
ColumnCount | 2
ColumnWidths | 116 Pt;1800 Pt
Und den alten Code durch diesen ersetzen.
Gruß Elex
hier die gewünscht Anpassung für die UF2.
Für die Listbox im Eigenschaftenfenster diese Werte eintragen.
ColumnCount | 2
ColumnWidths | 116 Pt;1800 Pt
Und den alten Code durch diesen ersetzen.
Code:
Private Sub Textbox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim ArrWerte, ArrAusgabe, ArrZeile As Variant
Dim Fundzeile, Begriff As String
Dim k, i, n, a As Long
Me.ListBox2.Clear
Begriff = TextBox2
ArrWerte = Sheets("Artikel").Cells(1).CurrentRegion
If IsNumeric(Begriff) Then
If MsgBox("Suchen als Ja = Zahl Nein = Text", vbYesNo Or vbQuestion, "Zahl oder Text?") = vbYes Then a = 1
End If
If a = 1 Then 'Bei Ja/Zahl
For k = 2 To UBound(ArrWerte, 1) 'Zeilen
For i = 1 To 5
n = Choose(i, "1", "10", "11", "12", "13") 'Spalten(A, J, K, L, M) durchsuchen
If InStr(1, Fundzeile, k, 1) Then
Exit For
Else
If ArrWerte(k, n) = Begriff Then Fundzeile = Fundzeile & " " & k
End If
Next i
Next k
Else 'bei Nein/Text
For k = 2 To UBound(ArrWerte, 1) 'Zeilen
For i = 2 To 9 'Spalten (B - I) durchsuchen
If InStr(1, Fundzeile, k, 1) Then
Exit For
Else
If InStr(1, ArrWerte(k, i), Begriff, 1) Then Fundzeile = Fundzeile & " " & k
End If
Next i
Next k
End If
If Fundzeile = "" Then Exit Sub
ArrZeile = Split(Mid(Fundzeile, 2))
ReDim ArrAusgabe((UBound(ArrZeile, 1) + 1) * 14, 1 To 2)
n = 1
For k = 0 To UBound(ArrZeile, 1)
For i = 1 To 13
ArrAusgabe(n, 1) = ArrWerte(1, i)
ArrAusgabe(n, 2) = ArrWerte(ArrZeile(k), i)
n = n + 1
Next i
ArrAusgabe(n, 1) = String(40, "-")
ArrAusgabe(n, 2) = String(300, "-")
n = n + 1
Next k
Me.ListBox2.List = ArrAusgabe
End SubGruß Elex