Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen

range.find mit 2 Suchbegriffen

Betrifft: range.find mit 2 Suchbegriffen von: Joachim
Geschrieben am: 26.09.2014 11:02:03

Hallo,

ich hab eine Suchfunktion mit usedrange.find geschrieben. Funktioniert wunderbar.
Allerdings kann ich immer nur nach einem Begriff suchen.
Kann ich die Funktion so erweitern, dass ich einen 2. Suchbegriff einbringen kann?
Beide Begriffe sollen mit UND verküpft sein.

Beispiel:
Suche nach Restaurant UND italienisch findet nur Restaurants, die ital. Essen haben. Andere Restaurants bzw. Reiseleiter, die ital. sprechen, werden nicht angezeit. Bisher werden bei Eingabe von italienisch Restaurants und Reiseleiter ausgegeben.

Den ersten Suchbegriff würde ich gerne über ein Kombinationsfeld auswählen, der 2. ist Freitext.

Gruss
Joachim

  

Betrifft: AW: range.find mit 2 Suchbegriffen von: Adis
Geschrieben am: 26.09.2014 12:57:03

Hallo

ich kenne jetzt das existierende Makro nicht, gebe aber einen Tipp von mir.
Unten ein kurzes Beispiel wie ich prinzipiell solches Doppelsuchen löse.
Es gibt sicher modernere und bessere Varianten von den echten Profis.

Es dient auch mehr als Demo im Sinne eines gedankliches Anschubsen wie man
seine Lösung selbst aufbauen kann. Manchmal reicht dafür ein Beispiel aus.

Sub DoppelNamen_suchen()
 Sheets("Tabelle1").Select
   SuchName1 = "Restaurant"
   SuchName2 = "Italien"
   'gesucht wird der 1. Hauptbegriff, spaeter mit FindNext alle aktiven Zellen
   Cells.Find(What:=SuchName1, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
      SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
   '1. Zell Adresse notieren!
   Adr1 = ActiveCell.Address
   
   Do 'Do Loop Schleife zum weitersuchen mit Auswertung SuchName2
      If ActiveCell.Offset(0, 1) = SuchName2 Then MsgBox "gefunden"
      Cells.FindNext(After:=ActiveCell).Activate
   Loop Until ActiveCell.Address = Adr1
End Sub
Gruss Adis


  

Betrifft: AW: range.find mit 2 Suchbegriffen von: Joachim
Geschrieben am: 26.09.2014 13:14:01

Hallo,

hier mein Code für die Suche:

akt_ws = ActiveSheet.name
Set wb = ThisWorkbook
Suchwert = InputBox("Bitte Suchbegriff eingeben")
If Suchwert = "" Then Exit Sub

UserForm1.ListBox1.Clear 'Liste löschen, falls nicht leer
Application.ScreenUpdating = False

Sheets("Tabelle").Select
Set ws = Sheets("Tabelle")
Set Fundortneu = ws.UsedRange.Find(What:=Suchwert, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not Fundortneu Is Nothing Then 'erster Eintrag gefunden
Set Fundortalt = Fundortneu 'ersten gefundenen Eintrag merken
ZeileAlt = Fundortneu.Row
Do 'weitersuchen
lfd = Range(Fundortneu.Offset(, 1 - Fundortneu.Column).Address()).Value
name = Range(Fundortneu.Offset(, 2 - Fundortneu.Column).Address()).Value
ort = Range(Fundortneu.Offset(, 3 - Fundortneu.Column).Address()).Value
kategorie = Range(Fundortneu.Offset(, 5 - Fundortneu.Column).Address()).Value
essen = Range(Fundortneu.Offset(, 6 - Fundortneu.Column).Address()).Value
apartner = Range(Fundortneu.Offset(, 7 - Fundortneu.Column).Address()).Value
funktion = Range(Fundortneu.Offset(, 8 - Fundortneu.Column).Address()).Value

TrageInListeEin lfd, name, ort, kategorie, essen, apartner, funktion 'eintragen
NeuSuchen:
Set Fundortneu = ws.UsedRange.FindNext(Fundortneu)
If Fundortalt.Address = Fundortneu.Address Then Exit Do 'bis der erste Eintrag wieder gefunden wird
If Fundortneu.Row = ZeileAlt Then
GoTo NeuSuchen
Else
ZeileAlt = Fundortneu.Row
End If
Loop
End If

Vielleicht hilft das weiter.

Gruss
Joachim


  

Betrifft: AW: range.find mit 2 Suchbegriffen von: Adis
Geschrieben am: 27.09.2014 00:11:22

Hallo

ich habe mir den Code angesehen und überarbeitet. Bitte erst in einer Kopie Datei
ausprobieren ob das Makro richtig laeuft. Ich habe keine Beispiel Datei vorliegen.

Kopfzerbrechen bereitete mir dieser Teil. Ich habe geraetselt wie er funktioniert?
Verwirrend war für mich das abziehnen der Column sowie am Ende .Address Angabe.
lfd = Range(Fundortneu.Offset(, 1 - Fundortneu.Column).Address()).Value

Man kann auf Range verzichten und kürzer schreiben: lfd = Fundortneu.Offset(, -1).Value
Bitte nachprüfen ob mein um 1 geaenderter Offset mit dem Original Makro übereinstimmt.

Der Code blieb weitgehend im Original erhalten. Veraendert wurde Suchwert1 + Suchwert2
Suchwert1 wird bei mir aus einer ComboBox geladen, die sich im aktiven Blatt befindet.
Ausgewertet wird die Zeile: If essen = Suchwert2 Then -TrageInListeEin- aufrufen
Hier kann selbst festgelegt werden was ausgewertet wird: essen, Kategorie, function

Bitte das Makro testen und Rückmeldung ob die Aufgabe so lösbar ist.
Würde mich freuen wenn es klappt. Sonst nochmal überdenken.

Sub Suchlauf_Doppelbegriff()
akt_ws = ActiveSheet.Name
Set wb = ThisWorkbook
Set dlg = ActiveSheet.DropDowns(1)  'ComboBox im aktiven Blatt
Suchwert1 = dlg.List(dlg.ListIndex) 'Wert aus ComboBox laden
Suchwert2 = InputBox("Bitte Suchbegriff eingeben", Suchwert1)
If Suchwert2 = "" Then Exit Sub

UserForm1.ListBox1.Clear 'Liste löschen, falls nicht leer
Application.ScreenUpdating = False

Sheets("Tabelle").Select
Set ws = Sheets("Tabelle")
Set Fundortneu = ws.UsedRange.Find(What:=Suchwert1, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not Fundortneu Is Nothing Then 'erster Eintrag gefunden
Set Fundortalt = Fundortneu 'ersten gefundenen Eintrag merken
ZeileAlt = Fundortneu.Row

Do 'weitersuchen
lfd = Fundortneu.Offset(, -1).Value
Name = Fundortneu.Offset(, 0).Value
ort = Fundortneu.Offset(, 1).Value
kategorie = Fundortneu.Offset(, 3).Value
essen = Fundortneu.Offset(, 4).Value
apartner = Fundortneu.Offset(, 5).Value
funktion = Fundortneu.Offset(, 6).Value

If essen = Suchwert2 Then  'Auswertung 2. Suchbegriff
   TrageInListeEin lfd, Name, ort, kategorie, essen, apartner, funktion 'eintragen
End If

NeuSuchen:
Set Fundortneu = ws.UsedRange.FindNext(Fundortneu)
If Fundortalt.Address = Fundortneu.Address Then Exit Do 'bis der erste Eintrag wieder gefunden  _
wird
If Fundortneu.Row = ZeileAlt Then
GoTo NeuSuchen
Else
ZeileAlt = Fundortneu.Row
End If
Loop
End If
End Sub
Gruss Adis


  

Betrifft: AW: range.find mit 2 Suchbegriffen von: Joachim
Geschrieben am: 29.09.2014 13:13:14

Hallo Adis,

leider ist grad viel andere Arbeit zu tun. Ich komm jetzt nicht dazu, es zu testen.
Danke schon mal für deine Antwort.

Gruss
Joachim


  

Betrifft: AW: range.find mit 2 Suchbegriffen von: Joachim
Geschrieben am: 29.09.2014 16:14:57

Hallo Adis,

vielen Dank für den Code. Leider ist grad andere Arbeit angesagt. Hab keine Zeit es zu testen.

Gruss
Joachim


  

Betrifft: AW: range.find mit 2 Suchbegriffen von: Adis
Geschrieben am: 29.09.2014 22:37:21

Hallo

kein Problem, ich warte ab was beim probieren rauskommt.
Sollte das Makro nicht auf Anhieb klappen waere Rückmeldung nett,
der grundsaetzliche Lösungsansatz müsste m.Erachtens richtig sein.

Gruss Adis


  

Betrifft: AW: range.find mit 2 Suchbegriffen von: Hajo_Zi
Geschrieben am: 01.10.2014 07:32:49

warum offen lass dies doch den Fragesteller entscheiden. Es ist Heute nicht üblich eine Rückmeldung zu geben und so ist der Beitrag 6 Tage offen.

GrußformelHomepage