VBA-Suchefunktion - doppelte vermeiden

Hallo,
ich hab mir ne Suchfunktion aus dem Forum geschnappt und für mich angepasst.
Einen Schönheitsfehler hat sie noch:
Wenn der Suchbegriff in einer Zeile zweimal auftaucht, wird dieser auch zweimal ausgegeben.
Ich will, dass das Makro dann in die nächste Zeile springt, sobald er in der Zeile was gefunden hat.
Hier ein Ausschnitt meines Codes:
Set wb = ThisWorkbook
Suchwert = InputBox("Suchbegriff eingeben")
If Suchwert = "" Then Exit Sub
UserForm1.ListBox1.Clear 'Liste löschen, falls nicht leer
Application.ScreenUpdating = False
Sheets("Strom").Select
Set ws = Sheets("Strom")
Set Fundortneu = ws.UsedRange.Find(Suchwert, , , xlPart)
If Not Fundortneu Is Nothing Then 'erster Eintrag gefunden
TrageInListeEin "FDH-Nr", "Lieg_Bezeichnung", "Geb_Bezeichnung"
fdh_nr = Range(Fundortneu.Offset(, 2 - Fundortneu.Column).Address()).Value
lieg_bez = Range(Fundortneu.Offset(, 8 - Fundortneu.Column).Address()).Value
geb_bez = Range(Fundortneu.Offset(, 15 - Fundortneu.Column).Address()).Value
TrageInListeEin fdh_nr, lieg_bez, geb_bez 'eintragen
Set Fundortalt = Fundortneu 'ersten gefundenen Eintrag merken
Do 'weitersuchen
Set Fundortneu = ws.UsedRange.FindNext(Fundortneu)
If Fundortalt.Address = Fundortneu.Address Then Exit Do 'bis der erste Eintrag wieder gefunden wird
fdh_nr = Range(Fundortneu.Offset(, 2 - Fundortneu.Column).Address()).Value
lieg_bez = Range(Fundortneu.Offset(, 8 - Fundortneu.Column).Address()).Value
geb_bez = Range(Fundortneu.Offset(, 15 - Fundortneu.Column).Address()).Value
TrageInListeEin fdh_nr, lieg_bez, geb_bez ' eintragen
End If
Loop
End If
Ich probier da schon länger rum, komm aber nicht auf das gewünscht Ergebnis.
Gruss
Joachim

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Joachim,
mit den folgenden Anpassungen sollten die Fundstellen innerhalb der gleichen Tabellen-Zeile übersprungen werden. Wichtig ist dabei auch, das die Parameter für die Find-Anweisung vollständig vorgegegben werden, da sonst die Einstellungen einer früheren Suche zu einem unerwarteten Ergebnis führen.
Die Zeilennummer der jeweils gefundenen Zelle wird zwischengespeichert und mit der Zeile der nächsten Fundstelle verglichen.
Gruß
Franz


Set wb = ThisWorkbook
Suchwert = InputBox("Suchbegriff eingeben")
If Suchwert = "" Then Exit Sub
'UserForm1.ListBox1.Clear 'Liste löschen, falls nicht leer
Application.ScreenUpdating = False
Sheets("Strom").Select
Set ws = Sheets("Strom")
Set Fundortneu = ws.UsedRange.Find(What:=Suchwert, LookIn:=xlValues, _
lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext)
If Not Fundortneu Is Nothing Then 'erster Eintrag gefunden
TrageInListeEin "FDH-Nr", "Lieg_Bezeichnung", "Geb_Bezeichnung"
Set Fundortalt = Fundortneu 'ersten gefundenen Eintrag merken
ZeileAlt = Fundortneu.Row
Do 'weitersuchen
FDH_Nr = Range(Fundortneu.Offset(, 2 - Fundortneu.Column).Address()).Value
lieg_bez = Range(Fundortneu.Offset(, 8 - Fundortneu.Column).Address()).Value
geb_bez = Range(Fundortneu.Offset(, 15 - Fundortneu.Column).Address()).Value
TrageInListeEin FDH_Nr, lieg_bez, geb_bez '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

Beliebteste Forumthreads (12 Monate)

VBA-Suchefunktion - doppelte vermeiden

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA-Suchefunktion - doppelte vermeiden

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread