In ListBox1 Eintrag suchen und auswählen/markieren

Private Sub TextBoxsucheLB_Change() Dim Suchbegriff As Range With Range("A1:A" & Range("A65536").End(xlUp).Row) Set Suchbegriff = .Find(What:=TextBox1, LookIn:=xlValues) If Not Suchbegriff Is Nothing Then ListBox1.ListIndex = Suchbegriff.Row - 1 End If End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub TextBoxsucheLB_Change() Dim liSearch As Integer, liMsg As Integer, liSearch1 As Integer For liSearch = 0 To ListBox1.ListCount - 1 For liSearch1 = 0 To ListBox1.ColumnCount - 1 If InStr(1, LCase(ListBox1.Column(liSearch1, liSearch)), LCase(TextBoxsucheLB.Text)) _ > 0 Then ListBox1.ListIndex = liSearch End If Next Next End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Suchfunktion nach Stoffbezeichnung If KeyCode = 13 Then 'Suche durchführen auf Enter: Dim liSearch As Integer, liMsg As Integer, liSearch1 As Integer For liSearch = ListBox1.ListCount - 1 To 0 Step -1 For liSearch1 = 0 To ListBox1.ColumnCount - 1 If InStr(1, LCase(ListBox1.Column(liSearch1, liSearch)), LCase(TextBox1.Text)) > 0 _ Then ListBox1.ListIndex = liSearch End If Next Next End If End Sub

Private Sub CommandButton1_Click() Dim Start() As Integer Dim sString As String Dim arr Dim Z As Long Dim S As Integer Dim ID ListBox1.MultiSelect = fmMultiSelectExtended ListBox1.ListIndex = -1 sString = TextBox1.Text arr = ListBox1.List ID = 0 For Z = 0 To UBound(arr) For S = 0 To UBound(arr, 2) If UCase(arr(Z, S)) Like "*" & UCase(sString) & "*" Then ReDim Preserve Start(0 To ID) Start(ID) = Z ID = ID + 1 Exit For End If Next Next For ID = LBound(Start) To UBound(Start) ListBox1.Selected(Start(ID)) = True Next ID End Sub

Hi Torsten, dass wäre leider keine Option, da es sich um chemische Bezeichnungen handelt, Beispiel:
Chlorbenzol
Benzol
Dimethylbenzol
Suchbegriff: Benzol
Die Liste ist sehr groß und zwischen A-Z herrscht in alphabetischer Reihenfolge eine riesige Lücke, die Stoffe haben außer die gleiche Basisstruktur dabei keine Zusammenhänge und es werden mit der Markierung auch CheckBox und ComboBox Einträge geladen, demnach würde MultiSelect keine Lösung darstellen. Ich würde am Liebsten solange Enter drücken bis der gesuchte Suchbegriff auftaucht, falls das möglich ist. Also wie es bisher ist, ist es schon sehr sehr gut, ich kann viel schneller und effizienter meine Begriffe finden und muss nicht die ganze Liste durchscrollen, jedoch, sobald ich "Benzol" o. Ä. suche hängt es beim ersten markierten Eintrag fest - ich denke mal das Makro sucht jedes Mal von oben nach unten, kann man es irgendwie so gestalten, dass es immer vom markierten also ListIndex 0 bis zum nächsten Eintrag sucht? Argh, ich weiss nicht wie ich das umsetze oder korrekt ausdrücken soll
Ich hoffe du verstehst was ich meine und bedanke mich wirklich vielmals für deine Mühe!
Lieben Gruß

Also hallo nochmals Senad,
hat etwas gedauert, was zu basteln.
Hier ein Code, der nach dem ersten Fund fragt, ob weitergesucht werden soll. Also in Textbox 1 den Suchbegriff eingeben und Enter druecken. Der erste Fund wird markiert und es erscheint eine Message Box und fragt, ob weitergesucht werden soll. Entweder wieder Enter (da der "Ja" Button default ist) oder auf "Ja" klicken zum weitersuchen. Wenn nicht weitergesucht werden soll dann auf "Nein".


Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'Suchfunktion nach Stoffbezeichnung
Dim StrSuch As String, firstadr As String, weiter%
If KeyCode = 13 Then
'Suche durchführen auf Enter:
StrSuch = TextBox1.Text
If StrSuch  "" Then
With Sheets("Sheet2").Range("L2:L20")
Set sucher = .Find(what:=StrSuch, Lookat:=xlPart)
If Not sucher Is Nothing Then
firstadr = sucher.Address
ListBox1.ListIndex = sucher.Row - 2
weiter = MsgBox("Nächste Suchen", 36)
If weiter = 6 Then
Do
Set sucher = .FindNext(sucher)
ListBox1.ListIndex = sucher.Row - 2
weiter = MsgBox("Nächste Suchen", 36)
If weiter = 7 Then Exit Sub
Loop While Not sucher Is Nothing And sucher.Address  firstadr
End If
End If
End With
End If
End If
End Sub

Gruss Torsten

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Suchfunktion nach Stoffbezeichnung auf Enter in TextBox1 Dim StrSuch As String, firstadr As String, weiter%, sucher As Variant If KeyCode = 13 Then 'Suche durchführen auf Enter: StrSuch = TextBox1.Text If StrSuch "" Then With Sheets("Übersicht").Range("a5:a6000") Set sucher = .Find(what:=StrSuch, Lookat:=xlPart) If Not sucher Is Nothing Then firstadr = sucher.Address ListBox1.ListIndex = sucher.Row - 5 weiter = MsgBox("Weitersuchen?", 36) If weiter = 6 Then Do Set sucher = .FindNext(sucher) ListBox1.ListIndex = sucher.Row - 5 weiter = MsgBox("Weitersuchen?", 36) If weiter = 7 Then Exit Sub Loop While Not sucher Is Nothing And sucher.Address firstadr End If End If End With End If End If End Sub

Beliebteste Forumthreads (12 Monate)

In ListBox1 Eintrag suchen und auswählen/markieren

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

In ListBox1 Eintrag suchen und auswählen/markieren

31 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread