Hallo,

Ich habe ein Problem mit meinen Schleifen. Ich rufe die unten angegebene Sub ’Suchen’ aus einer anderen Sub heraus aus.
Nun möchte ich, dass in allen Blättern der jeweils benutzte Bereich durchsucht wird. Wenn der Suchbegriff nicht gefunden wird, soll die Meldung „Keine Fundstellen“ erscheinen. Wenn der Suchbegriff gefunden wird, soll unterschieden werden, ob er im Übersichtsblatt ist oder nicht. Das Übersichtsblatt ist das erste Arbeitsblatt und soll nicht mit durchsucht werden, d.h. wenn der Treffer auf dem Übersichtsblatt ist, soll nach dem nächsten Treffer gesucht werden. Wenn dann der Suchbegriff in einem anderen Arbeitsblatt als dem Übersichtsblatt gefunden wurde, soll die
Sub ‚ Suchkatalogblattanlegen’ aufgerufen werden. Bis zu der Sternchenreihe läuft es auch, aber dann schein ich eine Endlosschleife drin zu haben.

Würde mich freuen, wenn jemand den Fehler finden würde.
Mhh, wenn ich den Code hier reinstelle, ist er immer schön strukturiert. In der Vorschau ist dann immer alles nur gerade. Vielleicht kannmir auch da jemand einen Tip geben.

Ich habe deshalb den Quelltext nochmal als Word Dokument auf den Server geladen:
https://www.herber.de/bbs/user/1366.doc

Vielen Dank.

Gruß

Peppi

Private Sub Suche(strSuchtext As String)

Dim SuchKatalogblattName As String
Dim objBlatt As Worksheet
Dim objSuchKatalogblatt As Worksheet
Dim objZelle As Range
Dim objZeile As Range
Dim strErsteFundstelle As String
Dim intButton As Integer
Dim objForm As UserForm
Dim strFundstelle As String

'***************************************************
'wir kommen hier von der Public Sub Suchen() aus hin
'***************************************************
'Prüfen, ob SuchKatalogblatt bereits existiert
Set objSuchKatalogblatt = GetWorksheet(strSuchtext)
'Wenn SuchKatalogblatt nicht existiert, dann...
'If 1
If objSuchKatalogblatt Is Nothing Then
'Alle Blätter durchlaufen
For Each objBlatt In ActiveWorkbook.Worksheets
'Verwendeten Bereich jedes Blatts durchsuchen
With objBlatt.UsedRange
'Suchfunktion aufrufen
Set objZelle = .Find(What:=Trim(strSuchtext), LookIn:=xlValues)
'Wenn erster Treffer, dann...
If Not objZelle Is Nothing Then
'... Fundstelle merken
strErsteFundstelle = objBlatt.Name & "!" & objZelle.Address
'Wenn der Treffer nicht im Übersichtsblatt ist
If objBlatt.Name <> "Übersicht" Then
'Sub Suchkatalogblattanlegen aufrufen
Call Suchkatalogblattanlegen(strSuchtext, strErsteFundstelle, objBlatt, objZelle)
Exit Sub
End If
If objBlatt.Name = "Übersicht" Then
Do
'Nach nächstem Vorkommen suchen
Set objZelle = .FindNext(objZelle)
strFundstelle = objBlatt.Name & "!" & objZelle.Address
If objBlatt.Name <> "Übersicht" Then
'Sub Suchkatalogblattanlegen aufrufen
Call Suchkatalogblattanlegen(strSuchtext, strErsteFundstelle, objBlatt, objZelle)
Exit Sub
End If
Loop
End If
Else
'Infobox mit "Keine Fundstellen!" öffnen
MsgBox "Keine Fundstellen!0000!", vbInformation, APP_NAME
Exit Sub
End If
End With
Next
End If