Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1672to1676
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
Inhaltsverzeichnis

Suche über Userform mit Text- und Listbox

Suche über Userform mit Text- und Listbox
07.02.2019 06:30:37
Markus
Hallo Zusammen,
ich möchte über eine Userform mit der Eingabe in TextBoxen entsprechende Projekte in meiner Datenbank finden und in einer Listbox anzeigen. Hierzu habe ich im Netz den folgenden Code gefunden. Dieser funktioniert für die Suche über 2 Textboxen in 2 Spalten auch sehr gut. Jetzt würde ich diesen Code aber gerne um die Suche in 3 bis 4 weiteren Spalten erweitern über 3 bis 4 neue Textboxen, scheitere aber an der Eingabe hierzu. Ist dies überhaupt möglich?
Private Sub CommandButton1_Click()
Sheets("Projekte").Activate
Dim strSuch As String, intSuchSP As Integer
Dim strSuch2 As String, intSuchSp2 As Integer
Dim rngFund As Range, strAdr As String, lngFundZeile As Long, i As Integer
'Listbox leeren
Projektsuche.ListBox1.Clear
Projektsuche.ListBox1.ColumnCount = 7    'Listbox bekommt 4 Spalten (kannst du auch ?ber die  _
Einstellungen einstellen)
'Suchbegriffe und Spalten definieren:
If Len(Projektsuche.TextBox1) > 0 Then
strSuch = Projektsuche.TextBox1.Text
intSuchSP = 1
If Len(Projektsuche.TextBox2) > 0 Then
strSuch2 = UCase(Projektsuche.TextBox2.Text)     'Ucase zum Ignorieren von Gross-/ _
Kleinschreibung
End If
intSuchSp2 = 2
ElseIf Len(Projektsuche.TextBox2) > 0 Then
strSuch = Projektsuche.TextBox2.Text
intSuchSP = 2
strSuch2 = ""  'Textbox1 ist leer!
intSuchSp2 = 1
Else
MsgBox "Bitte Suchbegriff eingeben!"
Exit Sub    'Makro direkt verlassen
End If
'Suchen
Set rngFund = Columns(intSuchSP).Find(strSuch, LookIn:=xlValues, lookat:=xlPart)
'Wurde der Suchbegriff gefunden?
If Not rngFund Is Nothing Then
strAdr = rngFund.Address         'erste Adresse merken (verhindert Endlosschleife)
'Schleife ?ber alle Suchbegriffe
Do
lngFundZeile = rngFund.Row    'Zeile des gefundenen Datensatzes
'zweiten Suchbegriff (strSuch2) kontrollieren (Ucase zum Ignorieren von  _
Kleinschreibung)
If InStr(UCase(Cells(lngFundZeile, intSuchSp2).Value), strSuch2) > 0 Or strSuch2 = ""  _
Then
'Liste f?llen
Projektsuche.ListBox1.AddItem Cells(lngFundZeile, 1).Value
For i = 1 To 6
Projektsuche.ListBox1.List(Projektsuche.ListBox1.ListCount - 1, i) = Cells( _
lngFundZeile, i + 1).Value
Next
End If
'N?chsten Suchbegriff finden (strSuch)
Set rngFund = Columns(intSuchSP).FindNext(rngFund)
Loop Until strAdr = rngFund.Address
End If
End Sub

Viel Grüße
Markus

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suche über Userform mit Text- und Listbox
07.02.2019 14:43:46
Matthias
Moin!
DAs sollte möglich sein. Kannst du ggf. mal erklären, wie du suchen willst!? Soll bei einem Treffer auf vorhandensein der anderen Werte in der selben Zellen getestet werden? UNd welcher Bereich soll dann in die LIstbox? Immer noch Spalte A bis G?
VG
AW: Suche über Userform mit Text- und Listbox
07.02.2019 14:56:13
Markus
Hallo Matthias,
in der Listbox sollen immer die gleichen Bereiche. Hier soll nicht, je nach Suche, variiert werden.
Die 7 TextBoxen beziehen sich auch auf die 7 Spalten. Die Suche soll ermöglichen, dass wenn ich z.B.in Spalte 2 einen Textteil eingebe, mir alle in Spalte 2 gefundenen Projekte die den Textteil enthalten aufgelistet werden. Gleiches gilt für die anderen Spalten. Mit dem oberen Code ist es derzeit möglich in beide TextBoxen Textteile einzutragen und danach zu suchen. Wäre natürlich schön wenn das weiterhin möglich wäre.
Das i-Tüpfelchen wären noch nach den Jahreszahlen in denen das Projekt angelegt bzw. abgeschlossen wurde zu filtern/ suchen. Diese Daten stehen allerdings in den Spalten 86 und 87 sprich "CH" und "CI".
Ich hoffe ich habe es verständlich wiedergegeben.
Gruß
Markus
Anzeige
AW: Suche über Userform mit Text- und Listbox
07.02.2019 19:11:03
Matthias
Moin!
Also habe den Code mal an deine Anforderungen umgebaut - also eigentlich neu geschrieben. Das in den alten Code zu implementieren, war mir zu umständlich. Der Code wäre jetzt so flexibel, dass du auch mehr als 7 Spalten (müssten aber ab Spalte A zusammenhängend sein) auswerten kannst. Müsstest dann nur eine Textbox8 etc. einfügen und im Code bei Anzahl = 7 auf anzahl = 8 ändern.
Dein i Tüpfelchen wäre auch kein Problem. Müsste nur wissen, in welchen Textboxen etc. du das einträgst und in welchem Format (2019 oder nur 19 ? ).
Der Code lief in meiner schnell erbauten Variante. Falls er bei dir nicht läuft, ggf. mal eine leere Mappe posten, damit man deinen Dateiaufbau sieht.
So hier mal der Code:
Private Sub CommandButton1_Click()
Dim quelle As Object
Dim daten
Dim zeile As Long, ende As Long, spalte As Long, eintrag As Long
Dim wert
Dim kriterien
Dim eintragen As Boolean
Dim anzahl As Long  'anzahl der Listboxen
Set quelle = Worksheets("Projekte")
Set kriterien = CreateObject("Scripting.Dictionary")
anzahl = 7
With Projektsuche
'Listbox leeren
.ListBox1.Clear
.ListBox1.ColumnCount = anzahl    'Listbox bekommt 4 Spalten (kannst du auch ?ber die   _
Einstellungen einstellen)
ende = quelle.Cells(quelle.Rows.Count, 1).End(xlUp).Row
daten = quelle.Range(quelle.Cells(1, 1), quelle.Cells(ende, anzahl))
For spalte = 1 To anzahl
If .Controls("Textbox" & spalte)  "" Then
kriterien.Add spalte, .Controls("Textbox" & spalte).Value
End If
Next
If kriterien.Count = 0 Then Exit Sub
For zeile = 1 To ende
eintragen = True
For eintrag = 1 To kriterien.Count
wert = daten(zeile, kriterien.keys()(eintrag - 1))
If InStr(1, wert, kriterien.items()(eintrag - 1), vbTextCompare) = 0 Then
eintragen = False
Exit For
End If
Next
If eintragen = True Then
.ListBox1.AddItem
For i = 1 To anzahl
.ListBox1.List(.ListBox1.ListCount - 1, i - 1) = daten(zeile, i)
Next
End If
Next
End With
End Sub

VG
Anzeige
AW: Suche über Userform mit Text- und Listbox
08.02.2019 07:13:43
Markus
Hallo Matthias,
vielen Dank für den Code. Leider klappt er bei mir nicht. Weder in der richtigen noch in der angehängten Beispieldatei. Er liefert eine Fehlermeldung (Das angegebne Objekt konnte nicht gefunden werden) in der Zeile:
If .Controls("Textbox" & spalte) "" Then
Ich habe nach dem Test in der der Userfomr der Beispieldatei zwei TextBoxen ergänzt in denen nach dem jeweiligen Datum gesucht werden soll.
https://www.herber.de/bbs/user/127501.xlsm
Gruß Markus
AW: Suche über Userform mit Text- und Listbox
08.02.2019 12:01:52
Matthias
MOin!
HIer deine Datei mal zurück. Musste sie aber in xls umwandeln, da ich sie sonst nicht öffnen kann (altes Excel). Grund des Fehlers war bei der Numerierung der Textboxen. Habe die mal umbenannt, so dass es passt. Das mit dem Jahr geht auch.
https://www.herber.de/bbs/user/127509.xls
VG
Anzeige
AW: Suche über Userform mit Text- und Listbox
09.02.2019 16:46:15
Markus
Hallo Matthias,
der Code läuft bestens, vielen Dank!!!
Eine Frage noch, welchen Befehlt müsste ich ergänzen bzw. die Zeile:
.ListBox1.List(.ListBox1.ListCount - 1, i - 1) = daten(zeile, i)
anpassen, dass auch die Daten in der Listbox aufgeführt werden?
Gruß Markus
AW: Suche über Userform mit Text- und Listbox
09.02.2019 17:43:37
Matthias
Moin!
Dann erstmal die Optik der UF anpassen (mit 2 Spalten mehr sind nicht mehr alle sichtbar. Im Code gab es dann ein paar mehr Veränderungen. Einmal Columncount und dann für das Datum eine eigene Schleife. SIeht dann so aus:
Private Sub CommandButton1_Click()
Dim quelle As Object
Dim daten, zeiten
Dim zeile As Long, ende As Long, spalte As Long, eintrag As Long
Dim wert
Dim kriterien
Dim eintragen As Boolean
Dim anzahl As Long  'anzahl der Listboxen
Set quelle = Worksheets("Projekte")
Set kriterien = CreateObject("Scripting.Dictionary")
anzahl = 7
With Projektsuche
'Listbox leeren
.ListBox1.Clear
.ListBox1.ColumnCount = anzahl + 2  'Listbox bekommt 4 Spalten (kannst du auch ?ber die _
Einstellungen einstellen)
ende = quelle.Cells(quelle.Rows.Count, 1).End(xlUp).Row
daten = quelle.Range(quelle.Cells(1, 1), quelle.Cells(ende, anzahl))
zeiten = quelle.Range(quelle.Cells(1, 86), quelle.Cells(ende, 87))
For spalte = 1 To anzahl + 2  '2 mehr für die Zeit
If .Controls("Textbox" & spalte)  "" Then
kriterien.Add spalte, .Controls("Textbox" & spalte).Value
End If
Next
If kriterien.Count = 0 Then Exit Sub
For zeile = 1 To ende
eintragen = True
For eintrag = 1 To kriterien.Count
If kriterien.keys()(eintrag - 1) > anzahl Then
wert = zeiten(zeile, kriterien.keys()(eintrag - 1) - anzahl)
Else
wert = daten(zeile, kriterien.keys()(eintrag - 1))
End If
If InStr(1, wert, kriterien.items()(eintrag - 1), vbTextCompare) = 0 Then
eintragen = False
Exit For
End If
Next
If eintragen = True Then
.ListBox1.AddItem
For i = 1 To anzahl
.ListBox1.List(.ListBox1.ListCount - 1, i - 1) = daten(zeile, i)
Next
For i = 1 To 2
.ListBox1.List(.ListBox1.ListCount - 1, anzahl + i - 1) = zeiten(zeile, i)
Next
End If
Next
End With
End Sub

VG
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige