AW: range.find mit 2 Suchbegriffen
27.09.2014 00:11:22
Adis
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