Schleifen (endlos?)

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm MsgBox
Bild

Betrifft: Schleifen (endlos?)
von: Peppi
Geschrieben am: 09.10.2003 17:22:52

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

Bild


Betrifft: AW: Schleifen (endlos?)
von: Michael Scheffler
Geschrieben am: 09.10.2003 18:29:31

Wo ist das Abbruchkriterium für Deine Do-Loop?


Bild


Betrifft: AW: Schleifen (endlos?)
von: Peppi
Geschrieben am: 09.10.2003 18:52:11

Hallo,

stimmt natürlich mit dem Abbruchkriterium. Ich bin bisher davon ausgegangen, dass automatisch abgebrochen wird, wenn die erte Fundstelle gefunden wird, die nicht auf dem Übersichtsblatt ist, weil ich dann ja eine andere Sub aufrufe und die jetzige mit ‚Exit Sub’ verlasse.
Ich habe nun mal versucht das so zu lösen, aber das funktioniert auch irgendwie nicht:

Loop While Not objBlatt.Name <> "Übersicht"

Also die Schleife soll ja so lange Laufen, bis der Name des Blattes nicht ‘Übersicht’ ist.
Wenn ich folgendes in dem Code auskommentiere funktioniert es natürlich, weil ja keine Endlosschleife mehr drin ist:

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


Würd mich freuen, wenn jemand Rat weiß.

Vielen Dank,

Gruß
Peppi

oder im wirklich Leben auch Sven genannt :-)


Bild


Betrifft: AW: Schleifen (endlos?)
von: Reinhard
Geschrieben am: 09.10.2003 18:56:37

Hi Peppi,
setze <pre> in die Zeile vor und </pre> in die Zeile nach dem Code.
Theoretisch wandelt auch das Forum Code um aber mit dem pre-Tag biste auf der
sicheren Seite.

Endlos liegt an dem findnext, du musst die erste Adresse die find liefert zwischenspeichern wie bei mir mit "Erste" getan und überprüfen.
Schau in das Hilfebeispiel zu findnext dort siehst du was ich meine.
Nachfolgender Code funktioniert mit excel2000,die test2 starten
Gruß
Reinhard

  
Private Sub Suche2(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
Dim Gefunden As Boolean
Gefunden = False
If objSuchKatalogblatt Is Nothing Then
    'Alle Blätter durchlaufen
    For Each objBlatt In ActiveWorkbook.Worksheets
        If objBlatt.Name <> "Tabelle2" Then
            With objBlatt.UsedRange
                Set objZelle = .Find(What:=Trim(strSuchtext), LookIn:=xlValues)
                If Not objZelle Is Nothing Then
                    Erste = objZelle.Address
                    Gefunden = True
                    Do
                        strFundstelle = objBlatt.Name & "!" & objZelle.Address
                        Call Suchkatalogblattanlegen(strSuchtext, strFundstelle, _
                                                                objBlatt, objZelle)
                        Set objZelle = .FindNext(objZelle)
                    Loop While Not objZelle Is Nothing And objZelle.Address <> Erste
                End If
             End With
        End If
    Next objBlatt
    'Infobox mit "Keine Fundstellen!" öffnen
    If Gefunden = False Then MsgBox "Keine Fundstellen!0000!", vbInformation, APP_NAME
End If
End Sub
Sub test2()
Call Suche2("Berlin")
End Sub
Sub Suchkatalogblattanlegen(strSuchtext As String, strFundstelle As String, objBlatt As Worksheet, objZelle As Range)
'MsgBox strSuchtext
MsgBox strFundstelle
'MsgBox objBlatt.Name
'MsgBox objZelle
End Sub



Bild


Betrifft: AW: Schleifen (endlos?)
von: Peppi
Geschrieben am: 09.10.2003 19:45:48

Hallo,

vielen Dank erstmal. Hat mich schon ein ganzes Stück weiter gebracht. Ich hatte jetzt das Problem, dass das Übersichtsblatt auch noch mit durchsucht wird. Das habe ich nun folgendermaßen versucht zu ändern:


Do
strFundstelle = objBlatt.Name & "!" & objZelle.Address
If objBlatt.Name <> "Übersicht" Then
Call Suchkatalogblattanlegen(strSuchtext, strFundstelle, objBlatt, objZelle)
Exit Do
Exit Sub
End If
Set objZelle = .FindNext(objZelle)
Loop While Not objZelle Is Nothing And objZelle.Address <> Erste

Damit will ich bewirken, dass sobald der erste Treffer auf einem Blatt, das nicht “Übersicht” heißt “ Suchkatalogblattanlegen“ aufruft und diese Sub verlässt. Die Fundergebnisse des Übersichtblattes werden nun nicht mehr angezeigt und beim ersten Treffer auf einem anderen Blatt wird auch „Suchkatalogblattanlegen“ aufgerufen, aber leider wird danach doch noch weiter gesucht. Wie kann ich das denn dann unterbinden?
Unten habe ich noch mal den gesamten Code angeführt

Gruß

Sven


Private Sub Suche2(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
Dim Gefunden As Boolean
Dim Erste As String
Gefunden = False
If objSuchKatalogblatt Is Nothing Then
    'Alle Blätter durchlaufen
    For Each objBlatt In ActiveWorkbook.Worksheets
        If objBlatt.Name <> "Tabelle2" Then
            With objBlatt.UsedRange
                Set objZelle = .Find(What:=Trim(strSuchtext), LookIn:=xlValues)
                If Not objZelle Is Nothing Then
                    Erste = objZelle.Address
                    Gefunden = True
                    Do
                        strFundstelle = objBlatt.Name & "!" & objZelle.Address
                        If objBlatt.Name <> "Übersicht" Then
                            Call Suchkatalogblattanlegen(strSuchtext, strFundstelle, objBlatt, objZelle)
                            Exit Do
                            Exit Sub
                        End If
                        Set objZelle = .FindNext(objZelle)
                    Loop While Not objZelle Is Nothing And objZelle.Address <> Erste
                End If
             End With
        End If
    Next objBlatt
    'Infobox mit "Keine Fundstellen!" öffnen
    If Gefunden = False Then MsgBox "Keine Fundstellen!0000!", vbInformation, APP_NAME
End If
End Sub



Bild


Betrifft: AW: Schleifen (endlos?)
von: Reinhard
Geschrieben am: 09.10.2003 20:13:52

Hi Sven,
ich versteh das jetzt nicht, meinen Makrocode musst du doch nur leicht anpassen.
If objBlatt.Name <> "Tabelle2" Then..
steht doch schon drin?
Natürlich musst du "Tabelle2" durch "Übersicht ersetzen:-)
Dann werden alle Blätter , außer bersicht, durchsucht und alle Fundstellen rufen
deine Suchaktaloganlegen(,,) auf.
Oder seh ich da was falsch?
Gruß
Reinhard


Bild


Betrifft: AW: Schleifen (endlos?)
von: Peppi
Geschrieben am: 09.10.2003 20:26:44

Hallo,

man oh man, da kann man auch schon mal den Wald vor lauter Bäumen nicht mehr sehen. Vielen Dank. Ich muss mich da ehrlich für meine Dummheit entschuldigen.


Nochmals vielen Dank.

Gruß Sven


Bild


Betrifft: Danke für die Rückantwort o.w.T.
von: Reinhard
Geschrieben am: 09.10.2003 22:25:01

.


Bild


Betrifft: AW: Schleifen (endlos?)
von: PeterW
Geschrieben am: 09.10.2003 19:10:24

Hallo Peppi,

für die richtige Darstellung im Forum fehlte deinem Code das "End Sub".

Gruß
Peter


Bild


Betrifft: AW: Schleifen (endlos?)
von: Peppi
Geschrieben am: 09.10.2003 19:48:59

Hallo,

vielen Dank. Da werde ich das nächste mal drauf achten.
Vielen Dank.
Gruß
Sven


 Bild

Beiträge aus den Excel-Beispielen zum Thema " "Summe = Summe + variable" geht bedingt"