09.03.2019, 23:13
Code:
Private Sub Txt_Ort_Change()
If Lst_ESB.Tag = "" Then
Dim LoI As Long ' Schleifenvariable
Dim LoJ As Long ' Schleifenvariable
Dim LoZeile As Long ' Variable für Zeile in Listbox
Dim RaFound As Range ' Variable für das Suchergebnis
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
If Txt_Ort = "" Then ' keine Eingabe in der Textbox
Lst_ESB.ColumnHeads = True ' Überschrift anzeigen
' gesamte Liste zuweisen
Lst_ESB.RowSource = "A" & LoStart & ":" & StSpalte & LoLetzte
Else
Lst_ESB.ColumnHeads = False ' Überschrift nicht anzeigen
Lst_ESB.RowSource = "" ' Adressbreich für Listbox löschen
With Worksheets(StTabelle)
' erste Zeile Suchen
' Wert suchen
Set RaFound = .Range(.Range(StSpalte & LoStart), _
.Range(StSpalte & LoLetzte)).Find(Txt_Ort & "*", _
.Cells(LoLetzte, InSpalte), , xlWhole, , xlNext)
' Begriff wurde gefunden
If Not RaFound Is Nothing Then
' letzte Spalte in der Überschriftenzeile
InSpalte1 = IIf(IsEmpty(.Cells(LoStart - 1, .Columns.Count)), _
.Cells(LoStart - 1, _
.Columns.Count).End(xlToLeft).Column, .Columns.Count)
' ID eintragen 1. Spalte
Lst_ESB.AddItem .Cells(LoStart - 1, 1)
If InSpalte1 > 0 Then
For LoJ = 1 To InSpalte1
' weitere Spalten eintragen
Lst_ESB.List(LoZeile, LoJ - 1) _
.Cells(LoStart - 1, LoJ)
Next
End If
LoZeile = LoZeile + 1
' Schleife von gefundener Stelle bis zu letzten Zeile
For LoI = RaFound.Row To LoLetzte
' Prüfen ob Ort noch mit dem Inhalt aus
' der Textbox beginnt
If UCase(Left(.Cells(LoI, InSpalte), Len(Txt_Ort))) _
= UCase(Txt_Ort) Then
' Ort eintragen 1. Spalte
Lst_ESB.AddItem .Cells(LoI, 1)
If InSpalte1 > 1 Then
For LoJ = 2 To InSpalte1
' weitere Spalten eintragen
Lst_ESB.List(LoZeile, LoJ - 1) _
= .Cells(LoI, LoJ)
Next
End If
LoZeile = LoZeile + 1 ' Zeilennummer um 1 erhöhen
' auskommentiert wegen Umlaute
'Else
' Schleife verlasen
'Exit For
Else
If UCase(Left(.Cells(LoI, InSpalte), 1)) _
<> UCase(Left(Txt_Ort, 1)) Then
Exit For
End If
End If
Next
End If
End With
End If
Set RaFound = Nothing ' Variable leeren
Application.ScreenUpdating = True ' Bildschirmaktualiserung ein
End If
End SubLst_ESB.List(LoZeile, LoJ - 1) _
=.Cells(LoStart - 1, LoJ)
Die Istwerte im Fehlerfall
LOJ = 11 (12 Spalten gibt es ?)
LoZeile = 0
LoStart = 4 (In Zeile 3 stehen die Überschriften)
Brauche da mal eure Hilfe.
Gruß Arni49
