Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 11:49:37
Array verwenden
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
25.04.2024 10:30:04
Suche mit MINWENNS und Rückgabe mehrerer Werte
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1812to1816
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1812to1816
1812to1816
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Suchen in ListBox

Suchen in ListBox
10.02.2021 14:42:54
Gerald
Hallo,
ich versuche eine Userform mit Listbox und Textbox mit Suchfunktion zu erstellen. Die Listbox (zweispaltig) wird aus einer Tabelle gefüllt. Über die Textbox gebe ich einen Suchbegriff ein. In der Listbox kann ich dann die markierten Suchergebnisse in in eine Zieltabelle schreiben. Das funktioniert soweit.
Mein Problem ist, wenn ich in der Listbox die Suchergebnisse markiere und will dann einen weiteren Suchbegriff in der Textbox eingeben, werden die markierten Ergebnisse in der Listbox wieder gelöscht.
Kann ich das irgendwie umgehen?
Ich würde gerne Suchbegriff eingeben, in der Listbox markieren und wieder einen Suchbegriff eingeben. Die vorherigen Markierungen sollten dabei erhalten bleiben.
Gruß,
Gerald
Hier wäre der Code: 

Private Sub UserForm_Activate()
Dim lZeile, iRow, iRowU As Long
Dim arr() As Variant
With wskatalog
lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
ListBox1.Clear
For iRow = 2 To lZeile
If .Cells(iRow, 1)  "" Then
ReDim Preserve arr(0 To 1, 0 To iRowU)
arr(0, iRowU) = .Cells(iRow, 1)
arr(1, iRowU) = .Cells(iRow, 3)
iRowU = iRowU + 1
End If
Next iRow
With ListBox1
.ColumnCount = 2
.ColumnWidths = "150; 300"
.Font.Size = 10
.Column = arr
.ListStyle = fmListStyleOption
.MultiSelect = fmMultiSelectMulti
End With
End With
End Sub

Private Sub cmd_Auswahl_uebernehmen_Click()
Dim i As Integer
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
wsstelle.Cells(Rows.Count, 3).End(xlUp).Offset(1) = .List(i, 0)
wsstelle.Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(i, 1)
End If
Next i
End With
TextBox1 = ""
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next i
End Sub

> 

Private Sub TextBox1_Change()
Dim i  As Integer
Dim lngLaenge  As Long
Dim strText As String
Me.ListBox1.Clear
UserForm_Activate
lngLaenge = Len(Me.TextBox1.Value)
With ListBox1
If Left(Me.TextBox1.Value, 1) = "*" Then
strText = LCase(Replace(Me.TextBox1.Value, "*", ""))
For i = .ListCount - 1 To 0 Step -1
If InStr(.List(i, 0), strText, vbTextCompare) > 0 Or InStr(.List(i, 1), strText,  _
vbTextCompare) > 0 Then
Else
.RemoveItem i
End If
Next i
Else
For i = .ListCount - 1 To 0 Step -1
If Left(.List(i, 0), lngLaenge) = Me.TextBox1.Value Or _
LCase(Left(.List(i, 1), lngLaenge)) = LCase(Me.TextBox1.Value) Then
Else
.RemoveItem i
End If
Next i
End If
End With
End Sub

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchen in ListBox
10.02.2021 15:00:47
Nepumuk
Hallo Gerald,
dann darfst du die Listbox nicht neu laden.
Zudem würde ich das Array auf Modulebene deklarieren, dann musst du nur noch: ListBox1.Column = arr ausführen.
Gruß
Nepumuk
AW: Suchen in ListBox
10.02.2021 15:31:12
Matthias
Moin!
Da musst da vor dem list.clear die vorher angezeigten Werte zwischenspeichern. Entweder nimmst du da ein array, einen string oder ein dictionary. Je nachdem, wie die Daten aussehen. Dort speicherst du die bisherigen Werte. Beim Filtern prüfst du dann wie bisher und zusätzlich, ob die Daten in deinem Zwischenspeichern stehen. Wenn sie dort sind, umgehst du das löschen.
Um das eindeutiger zu machen (falls in deiner Liste in Spalte A bspw. 2 Werte mit gleichem Wert sind), würde ich in die Listbox immer die Zeilennummer mit aufnehmen (in eine 3. Spalte aber nicht angezeigt). Damit hast du praktisch zu jedem Eintrag eine eindeutuge ID, die du speicherst. Macht es m.E. einfacher.
Soweit meine Idee. Falls du da irgendwie Hilfe brauchst, einfach nochmal melden.
VG
Anzeige
AW: Suchen in ListBox
10.02.2021 16:28:51
Gerald
Hallo Matthias,
vielen Dank für die schnelle Antwort!
Wenn du mir das mit dem Zwischenspeichern zeigen könntest, wäre super.
Die Werte in Spalte A sind eindeutig, keine doppelten Werte.
Spalte A sind Kurznamen, wie T.v. oder Wi.v.Miw, Spalte B sind die Langnamen (ausgeschrieben).
Gruß,
Gerald
AW: Suchen in ListBox
10.02.2021 16:48:57
Nepumuk
Hallo Gerald,
teste mal:
Option Explicit

Private arr() As Variant
Private mablnSelected() As Boolean

Private Sub UserForm_Activate()
    
    Dim iRow As Long, iRowU As Long
    
    With wskatalog
        For iRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(iRow, 1) <> "" Then
                Redim Preserve arr(0 To 1, 0 To iRowU)
                arr(0, iRowU) = .Cells(iRow, 1)
                arr(1, iRowU) = .Cells(iRow, 3)
                iRowU = iRowU + 1
            End If
        Next iRow
    End With
    
    
    
    With ListBox1
        .ColumnCount = 2
        .ColumnWidths = "150; 300"
        .Font.Size = 10
        .Column = arr
        .ListStyle = fmListStyleOption
        .MultiSelect = fmMultiSelectMulti
        
        Redim mablnSelected(0 To .ListCount - 1)
        
    End With
    
End Sub

Private Sub cmd_Auswahl_uebernehmen_Click()
    Dim i As Long
    
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                wsstelle.Cells(Rows.Count, 3).End(xlUp).Offset(1) = .List(i, 0)
                wsstelle.Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(i, 1)
                
                .Selected(i) = False
                mablnSelected(i) = False
                
            End If
        Next i
    End With
    
    TextBox1.Text = vbNullString
    
End Sub

Private Sub TextBox1_Change()
    
    Dim i As Long
    Dim lngLaenge As Long
    Dim strText As String
    
    lngLaenge = TextBox1.TextLength
    
    With ListBox1
        
        .Column = arr
        
        For i = 0 To .ListCount - 1
            .Selected = mablnSelected
        Next
        
        If Left(TextBox1.Value, 1) = "*" Then
            strText = LCase$(Replace$(TextBox1.Text, "*", ""))
            For i = .ListCount - 1 To 0 Step -1
                If InStr(.List(i, 0), strText, vbTextCompare) > 0 Or _
                    InStr(.List(i, 1), strText, vbTextCompare) > 0 Then
                    mablnSelected(i) = True
                Else
                    .RemoveItem i
                End If
            Next i
        Else
            strText = TextBox1.Text
            For i = .ListCount - 1 To 0 Step -1
                If Left$(.List(i, 0), lngLaenge) = strText Or _
                    LCase$(Left$(.List(i, 1), lngLaenge)) = LCase$(strText) Then
                    mablnSelected(i) = True
                Else
                    .RemoveItem i
                End If
            Next i
        End If
    End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Suchen in ListBox
10.02.2021 19:52:12
Matthias
Moin!
So ähnlich wie bei Nepumuk hätte ich es auch gelöst.
Hätte aber eine Änderung vorgeschlagen. Bei der Zeile hier: 
 For i = 0 To .ListCount - 1
.Selected = mablnSelected
Next

müsstest du glaube ich hinter mablnSelected noch ein (i) ergänzen.
Die MIttelzeile sollte dann so aussehen: 
.Selected = mablnSelected(i)

Ansonsten sollte wohl ein Fehler entstehen.
VG
AW: Suchen in ListBox
10.02.2021 19:58:01
Nepumuk
Ooooooops,
so natürlich:
        For i = 0 To .ListCount - 1
.Selected(i) = mablnSelected(i)
Next
Gruß
Nepumuk
Anzeige
AW: Suchen in ListBox
10.02.2021 23:16:34
Gerald
Hallo,
vielen Dank euch beiden für die Hilfe!!!
Folgendes ist aufgetreten:
Nach Aufruf der Listbox habe ich ein paar Zeilen selektiert. Anschließend bin ich in die Textbox um einen Begriff in der Liste zu suchen.
Beim ersten Buchstaben hat sich die Liste aktualisiert. Soweit so gut.
Beim Zweiten war Listbox "leer" und konnte nur noch abbrechen.
Vielleicht habt ihr noch eine Idee, woran es liegen könnte?
Gruß,
Gerald
AW: Suchen in ListBox
11.02.2021 08:32:44
Nepumuk
Hallo Gerald,
teste mal:
Option Explicit

Private arr() As Variant
Private mablnSelected() As Boolean

Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
    Dim lngIndex As Long
    
    With ListBox1
        
        For lngIndex = 0 To .ListCount - 1
            
            mablnSelected(lngIndex) = .Selected(lngIndex)
            
        Next
    End With
End Sub

Private Sub UserForm_Activate()
    
    Dim iRow As Long, iRowU As Long
    
    With wskatalog
        For iRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(iRow, 1) <> "" Then
                Redim Preserve arr(0 To 1, 0 To iRowU)
                arr(0, iRowU) = .Cells(iRow, 1)
                arr(1, iRowU) = .Cells(iRow, 3)
                iRowU = iRowU + 1
            End If
        Next iRow
    End With
    
    
    
    With ListBox1
        .ColumnCount = 2
        .ColumnWidths = "150; 300"
        .Font.Size = 10
        .Column = arr
        .ListStyle = fmListStyleOption
        .MultiSelect = fmMultiSelectMulti
        
        Redim mablnSelected(0 To .ListCount - 1)
        
    End With
    
End Sub

Private Sub cmd_Auswahl_uebernehmen_Click()
    Dim i As Long
    
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                wsstelle.Cells(Rows.Count, 3).End(xlUp).Offset(1) = .List(i, 0)
                wsstelle.Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(i, 1)
                
                .Selected(i) = False
                mablnSelected(i) = False
                
            End If
        Next i
    End With
    
    TextBox1.Text = vbNullString
    
End Sub

Private Sub TextBox1_Change()
    
    Dim i As Long
    Dim lngLaenge As Long
    Dim strText As String
    
    lngLaenge = TextBox1.TextLength
    
    With ListBox1
        
        .Column = arr
        
        For i = 0 To .ListCount - 1
            .Selected(i) = mablnSelected(i)
        Next
        
        If Left(TextBox1.Value, 1) = "*" Then
            strText = LCase$(Replace$(TextBox1.Text, "*", ""))
            For i = .ListCount - 1 To 0 Step -1
                If InStr(.List(i, 0), strText, vbTextCompare) > 0 Or _
                    InStr(.List(i, 1), strText, vbTextCompare) > 0 Then
                    mablnSelected(i) = True
                Else
                    If Not .Selected(i) Then .RemoveItem i
                End If
            Next i
        Else
            strText = TextBox1.Text
            For i = .ListCount - 1 To 0 Step -1
                If Left$(.List(i, 0), lngLaenge) = strText Or _
                    LCase$(Left$(.List(i, 1), lngLaenge)) = LCase$(strText) Then
                    mablnSelected(i) = True
                Else
                    If Not .Selected(i) Then .RemoveItem i
                End If
            Next i
        End If
    End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Suchen in ListBox
11.02.2021 10:51:05
Matthias
Moin Nepumuk!
Ich glaube in dem Code so wie er ist, ist ein Fehler im Ablauf. Hatte auch eben mal getestet und er hat teilweise mehr angezeigt. Durch das Filtern der Liste ändert sich ja auch der .listcount zum jeweiligen Filterzustand. Mit dem .listcount wird dann aber der Wert in der mablSelected gesetzt. Dieser Liste beruht aber auf einem Array über die urspr. Liste mit allen Werten. Daher passen dann die Zuordnungen von der aktuellen Zeile zu der im Array nicht mehr, da ja einige Zeilen fehlen.
Hier deshalb mal der Vorschlag mit 3 Spalten und der Zeilennummer als Index für die eindeutige Zuordnung. Die Spalte wird aber nicht mit angezeigt. 
Option Explicit
Private arr() As Variant
Private auswahl As String
Const tr = "#@"
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim lngIndex As Long
With ListBox1
For lngIndex = 0 To .ListCount - 1
If .Selected(lngIndex) Then
If InStr(1, auswahl, tr & .List(lngIndex, 0), vbTextCompare) = 0 Then auswahl =  _
tr & .List(lngIndex, 0) & auswahl
Else
If InStr(1, auswahl, tr & .List(lngIndex, 0), vbTextCompare) > 0 Then auswahl =  _
Replace(auswahl, tr & .List(lngIndex, 0), "")
End If
Next
End With
End Sub
Private Sub UserForm_Activate()
Dim iRow As Long, iRowU As Long
auswahl = tr
With wskatalog
For iRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(iRow, 1)  "" Then
ReDim Preserve arr(0 To 2, 0 To iRowU)
arr(0, iRowU) = iRow
arr(1, iRowU) = .Cells(iRow, 1)
arr(2, iRowU) = .Cells(iRow, 3)
iRowU = iRowU + 1
End If
Next iRow
End With
With ListBox1
.ColumnCount = 3
.ColumnWidths = "0;150; 300"
.Font.Size = 10
.Column = arr
.ListStyle = fmListStyleOption
.MultiSelect = fmMultiSelectMulti
ReDim mablnSelected(0 To .ListCount - 1)
End With
End Sub
Private Sub cmd_Auswahl_uebernehmen_Click()
Dim i As Long
With ListBox1
.Column = arr
For i = 0 To .ListCount - 1
If InStr(1, auswahl, tr & .List(i, 0), vbTextCompare) > 0 Then
.Selected(i) = True
Else
.Selected(i) = False
End If
Next
For i = 0 To .ListCount - 1
If InStr(1, auswahl, tr & .List(i, 0), vbTextCompare) > 0 Then
wsstelle.Cells(Rows.Count, 3).End(xlUp).Offset(1) = .List(i, 1)
wsstelle.Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(i, 2)
auswahl = Replace(auswahl, tr & .List(i, 0), "")
End If
Next i
End With
TextBox1.Text = vbNullString
End Sub
Private Sub TextBox1_Change()
Dim i As Long
Dim lngLaenge As Long
Dim strText As String
lngLaenge = TextBox1.TextLength
With ListBox1
.Column = arr
For i = 0 To .ListCount - 1
If InStr(1, auswahl, tr & .List(i, 0), vbTextCompare) > 0 Then
.Selected(i) = True
Else
.Selected(i) = False
End If
Next
If Left(TextBox1.Value, 1) = "*" Then
strText = LCase$(Replace$(TextBox1.Text, "*", ""))
For i = .ListCount - 1 To 0 Step -1
If InStr(.List(i, 0), strText, vbTextCompare) > 0 Or _
InStr(.List(i, 1), strText, vbTextCompare) > 0 Then
Else
If Not .Selected(i) Then .RemoveItem i
End If
Next i
Else
strText = TextBox1.Text
For i = .ListCount - 1 To 0 Step -1
If Left$(.List(i, 0), lngLaenge) = strText Or _
LCase$(Left$(.List(i, 1), lngLaenge)) = LCase$(strText) Then
Else
If Not .Selected(i) Then .RemoveItem i
End If
Next i
End If
End With
End Sub

VG
Anzeige
AW: Suchen in ListBox
11.02.2021 11:33:18
Gerald
Hallo Nepumuk,
jetzt ist es so,
ich selektiere in der Listbox Zeilen, klicke dann in die Textbox und gebe den ersten Buchstaben für die Suche ein.
In der Listbox sind die selektierten Zeilen eingefügt und markiert.
Die Begriffe mit dem ersten Buchstaben werden aufgelistet
Bei Eingabe des zweiten Buchstaben passiert bei der Suche nichts aber alle Einträge sind jetzt markiert.
Ich habe eine Beispieldatei hochgeladen. Falls du noch Nerven hast....
https://www.herber.de/bbs/user/143817.xlsm
Vielen Dank nochmal,
Gerald
Anzeige
AW: Suchen in ListBox
11.02.2021 17:21:25
Matthias
Moin!
Also hier zumindest mal meine Version 
Option Explicit
Private arr() As Variant
Private auswahl As String
Const tr = "#@"
Private Sub cmd_Auswahl_aufheben_Click()
ListBox1.Column = arr
auswahl = tr
End Sub
Private Sub cmd_Exit_Click()
Unload Me
End Sub
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim lngIndex As Long
With ListBox1
For lngIndex = 0 To .ListCount - 1
If .Selected(lngIndex) Then
If InStr(1, auswahl, tr & .List(lngIndex, 0), vbTextCompare) = 0 Then auswahl =  _
tr & .List(lngIndex, 0) & tr & auswahl
Else
If InStr(1, auswahl, tr & .List(lngIndex, 0), vbTextCompare) > 0 Then auswahl =  _
Replace(auswahl, tr & .List(lngIndex, 0) & tr, "")
End If
Next
End With
End Sub
Private Sub UserForm_Activate()
Dim iRow As Long, iRowU As Long
auswahl = tr
With wskatalog
For iRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(iRow, 1)  "" Then
ReDim Preserve arr(0 To 2, 0 To iRowU)
arr(0, iRowU) = iRow
arr(1, iRowU) = .Cells(iRow, 1)
arr(2, iRowU) = .Cells(iRow, 3)
iRowU = iRowU + 1
End If
Next iRow
End With
With ListBox1
.ColumnCount = 3
.ColumnWidths = "0;150; 300"
.Font.Size = 10
.Column = arr
.ListStyle = fmListStyleOption
.MultiSelect = fmMultiSelectMulti
ReDim mablnSelected(0 To .ListCount - 1)
End With
End Sub
Private Sub cmd_Auswahl_uebernehmen_Click()
Dim i As Long
With ListBox1
.Column = arr
For i = 0 To .ListCount - 1
If InStr(1, auswahl, tr & .List(i, 0) & tr, vbTextCompare) > 0 Then
.Selected(i) = True
Else
.Selected(i) = False
End If
Next
For i = 0 To .ListCount - 1
If InStr(1, auswahl, tr & .List(i, 0) & tr, vbTextCompare) > 0 Then
wsstelle.Cells(Rows.Count, 3).End(xlUp).Offset(1) = .List(i, 1)
wsstelle.Cells(Rows.Count, 6).End(xlUp).Offset(1) = .List(i, 2)
auswahl = Replace(auswahl, tr & .List(i, 0) & tr, "")
End If
Next i
End With
TextBox1.Text = vbNullString
End Sub
Private Sub TextBox1_Change()
Dim i As Long
Dim lngLaenge As Long
Dim strText As String
lngLaenge = TextBox1.TextLength
With ListBox1
.Column = arr
For i = 0 To .ListCount - 1
If InStr(1, auswahl, tr & .List(i, 0) & tr, vbTextCompare) > 0 Then
.Selected(i) = True
Else
.Selected(i) = False
End If
Next
If Left(TextBox1.Value, 1) = "*" Then
strText = LCase$(Replace$(TextBox1.Text, "*", ""))
For i = .ListCount - 1 To 0 Step -1
If InStr(.List(i, 0), strText, vbTextCompare) > 0 Or _
InStr(.List(i, 1), strText, vbTextCompare) > 0 Then
Else
If Not .Selected(i) Then .RemoveItem i
End If
Next i
Else
strText = TextBox1.Text
For i = .ListCount - 1 To 0 Step -1
If Left$(.List(i, 0), lngLaenge) = strText Or _
LCase$(Left$(.List(i, 1), lngLaenge)) = LCase$(strText) Then
Else
If Not .Selected(i) Then .RemoveItem i
End If
Next i
End If
End With
End Sub

Bei den Anzeigen kann man noch rumspielen, dass es anders ist. Jetzt werden bei jeder Suche die bisher ausgewählten mit angezeigt. Wenn du das nicht willst, die Zeilen
If Not .Selected(i) Then .RemoveItem i
hier im else Zweig von Textbox_Change rausnehmen.
VG
Anzeige
AW: Suchen in ListBox
11.02.2021 21:26:27
Gerald
Hallo Matthias,
genial!!
Funktioniert super!
Vielen, vielen Dank und noch einen schönen Abend,
Gerald

Links zu Excel-Dialogen

ListBox TextBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige