Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

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 CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Suchen und weitersuchen

nach unten

Betrifft: Suchen und weitersuchen von: Robert
Geschrieben am: 14.10.2020 18:17:52

Hallo liebe Exelexperten. Habe heute im Forum dieses Makro entdeckt. Es ist von heute. Nun meine Frage was muss ich anders Schreiben das es die gesamte Arbeitsmappe durchsucht.

Für Eure Hilfe wäre ich sehr dankbar.


Option Explicit

Private Sub CommandButton3_Click()
    Dim strSearch As String, strFirstAddress As String
    Dim objCell As Range
    Dim blnAbort As Boolean
    strSearch = InputBox("Suchbegriff:", "Suche nach...")
    If strSearch <> vbNullString Then
        Set objCell = Columns(2).Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlPart,  _
MatchCase:=False)
        If Not objCell Is Nothing Then
            strFirstAddress = objCell.Address
            Do
                Do
                    objCell.Select
                    If MsgBox("Weitersuchen?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then
                        blnAbort = True
                        Exit Do
                    End If
                    Set objCell = Columns(2).FindNext(After:=objCell)
                Loop Until objCell.Address = strFirstAddress
                If Not blnAbort Then If MsgBox("Letze Fundstelle." & vbLf & vbLf & "Nochmal von  _
 _
vorne?", _
                    vbQuestion Or vbYesNo, "Abfrage") = vbNo Then Exit Do
            Loop Until blnAbort
        Else
            MsgBox "nix gefunden"
        End If
    End If
End Sub

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Hajo_Zi
Geschrieben am: 14.10.2020 18:40:32

Sub Find_mehrmals()
    '**************************************************
    '* H. Ziplies                                     *
    '* 29.03.2020                                     *
    '* erstellt von HajoZiplies@WEB.de     Spam       *
'* http://Hajo-Excel.de
 *
    '**************************************************
    Dim Rafound As Range
    Dim StAdresse As String
    With Worksheets("Projekte")
        Set Rafound = .Columns(4).find("Ha", .Range("D1"), , xlPart, , xlNext)
        ' xlPart enthalten
        ' xlWhole kompletter Vergleich
        If Not Rafound Is Nothing Then
            MsgBox Rafound.Address
            StAdresse = Rafound.Address             ' erste Adresse merken
            Do                                      ' Such wiederholen
                Set Rafound = .Columns(4).FindNext(Rafound)
                If Not Rafound Is Nothing Then
                    If StAdresse = Rafound.Address Then
                        Exit Do                     ' erstes Ergebniszelle
                    Else
                        MsgBox Rafound.Address
                    End If
                End If
            Loop
        End If
    End With
    Set Rafound = Nothing
End Sub
GrußformelHomepage

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Nepumuk
Geschrieben am: 14.10.2020 18:50:35

Hallo Robert,

teste mal:

Option Explicit

Private Sub CommandButton3_Click()
    Dim strSearch As String, strFirstAddress As String
    Dim objCell As Range, objWorksheet As Worksheet
    Dim blnAbort As Boolean
    strSearch = InputBox("Suchbegriff:", "Suche nach...")
    If strSearch <> vbNullString Then
        Do
            For Each objWorksheet In ThisWorkbook.Worksheets
                Set objCell = objWorksheet.Cells.Find(What:=strSearch, _
                    LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
                If Not objCell Is Nothing Then
                    strFirstAddress = objCell.Address(External:=True)
                    Do
                        Call Application.Goto(Reference:=objCell)
                        If MsgBox("Weitersuchen?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then
                            blnAbort = True
                            Exit Do
                        End If
                        Set objCell = objWorksheet.Cells.FindNext(After:=objCell)
                    Loop Until objCell.Address(External:=True) = strFirstAddress
                End If
                If blnAbort Then Exit For
            Next
            If objCell Is Nothing Then
                Call MsgBox("Suchbegriff nicht gefunden.", vbExclamation, "Hinweis")
                Exit Do
            ElseIf Not blnAbort Then
                If MsgBox("Letze Fundstelle." & vbLf & vbLf & "Nochmal von vorne?", _
                    vbQuestion Or vbYesNo, "Abfrage") = vbNo Then Exit Do
            End If
        Loop Until blnAbort
    End If
End Sub

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Nepumuk
Geschrieben am: 14.10.2020 19:07:11

Hallo Robert,

da war noch ein Fehler im Code. Wenn der Suchbegriff nur einmal gefunden wurde, wurde eine falsche Meldung ausgegeben.

Option Explicit

Private Sub CommandButton3_Click()
    Dim strSearch As String, strFirstAddress As String
    Dim objCell As Range, objWorksheet As Worksheet
    Dim blnAbort As Boolean, blnFound As Boolean
    strSearch = InputBox("Suchbegriff:", "Suche nach...")
    If strSearch <> vbNullString Then
        Do
            For Each objWorksheet In ThisWorkbook.Worksheets
                Set objCell = objWorksheet.Cells.Find(What:=strSearch, _
                    LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
                If Not objCell Is Nothing Then
                    strFirstAddress = objCell.Address(External:=True)
                    blnFound = True
                    Do
                        Call Application.Goto(Reference:=objCell)
                        If MsgBox("Weitersuchen?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then
                            blnAbort = True
                            Exit Do
                        End If
                        Set objCell = objWorksheet.Cells.FindNext(After:=objCell)
                    Loop Until objCell.Address(External:=True) = strFirstAddress
                End If
                If blnAbort Then Exit For
            Next
            If objCell Is Nothing And Not blnFound Then
                Call MsgBox("Suchbegriff nicht gefunden.", vbExclamation, "Hinweis")
                Exit Do
            ElseIf Not blnAbort Then
                If MsgBox("Letze Fundstelle." & vbLf & vbLf & "Nochmal von vorne?", _
                    vbQuestion Or vbYesNo, "Abfrage") = vbNo Then Exit Do
            End If
        Loop Until blnAbort
    End If
End Sub

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Robert
Geschrieben am: 14.10.2020 20:05:30

Hallo Neupumuk. EDanke für Deine schnelle Hilfe. Habe noch ein Problem beim Weitersuchen kommt _ die 
Fehlermeldung Laufzeitfehler 91: Objektvariable oder Blockvariable nicht festgelegt
.In dem Makro ist dann die Zeile Fett und kursiv gelb gekennzeichnet.


Private Sub CommandButton1_Click()

    Dim strSearch As String, strFirstAddress As String

    Dim objCell As Range, objWorksheet As Worksheet

    Dim blnAbort As Boolean, blnFound As Boolean

    strSearch = InputBox("Suchbegriff:", "Suche nach...")

    If strSearch <> vbNullString Then

        Do

            For Each objWorksheet In ThisWorkbook.Worksheets

                Set objCell = objWorksheet.Cells.Find(What:=strSearch, _

                    LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

                If Not objCell Is Nothing Then

                    strFirstAddress = objCell.Address(External:=True)

                    blnFound = True

                    Do

                        Call Application.Goto(Reference:=objCell)

                        If MsgBox("Weitersuchen?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then

                            blnAbort = True

                            Exit Do

                        End If

                        Set objCell = objWorksheet.Cells.FindNext(After:=objCell)

                    Loop Until objCell.Address(External:=True) = strFirstAddress

                End If

                If blnAbort Then Exit For

            Next

            If objCell Is Nothing And Not blnFound Then

                Call MsgBox("Suchbegriff nicht gefunden.", vbExclamation, "Hinweis")

                Exit Do

            ElseIf Not blnAbort Then

                If MsgBox("Letze Fundstelle." & vbLf & vbLf & "Nochmal von vorne?", _

                    vbQuestion Or vbYesNo, "Abfrage") = vbNo Then Exit Do

            End If

        Loop Until blnAbort

    End If

End Sub
Hoffe Du kannst Dich dem Problem noch einmalannehmen.


Danke

LG Robert

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Robert
Geschrieben am: 14.10.2020 20:06:58

Die Zeile
  Loop Until objCell.Address(External:=True) = strFirstAddress


nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Nepumuk
Geschrieben am: 15.10.2020 11:48:05

Hallo Robert,

kann ich nicht nachvollziehen. Kannst du eine Mustermappe hochladen in welcher der Fehler auftaucht?

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: ralf_b
Geschrieben am: 15.10.2020 14:27:44

in der zeile darüber 
Set objCell = objWorksheet.Cells.FindNext(After:=objCell)
wird evtl.. dein Objekt zu nothing weil nichts gefunden wird.

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: ralf_b
Geschrieben am: 15.10.2020 14:27:47

in der zeile darüber 
Set objCell = objWorksheet.Cells.FindNext(After:=objCell)
wird evtl.. dein Objekt zu nothing weil nichts gefunden wird.

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Nepumuk
Geschrieben am: 15.10.2020 14:33:44

Hallo Ralf,

das kann nicht sein, denn schlimmstenfalls findet das Programm die erste Fundstelle nochmal. Außer sie wurde gelöscht. Warten wir mal Robert ab.

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Robert
Geschrieben am: 15.10.2020 17:09:17

Mit der Mappe hochladen ist schwierig. Erstens ist sie zu groß 13 MB und zweitens sind darin sehr viele Personenbezogene Daten.
Sie hat insgesamt 362 Arbeitsblätter.
Will nur ein Beispiel nennen wenn ich nach Lucka als Begriff suche, dann sucht es in Endlosschleife, wenn ich aber nach Paditz suche dann macht er nach der ersten Suche diese Fehlermeldung.
Weiss nicht woran es liegen kann. Vielleicht hilft das etwas weiter. Sonst müssten wir sehen wie wir es machen.


LG Robert

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Nepumuk
Geschrieben am: 15.10.2020 17:13:07

Hallo Robert,

was hast du gemacht bevor der Fehler auftrat? Wie gesagt, ich kann das in meiner Testmappe nicht nachvollziehen.

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Robert
Geschrieben am: 15.10.2020 17:21:33

Habe nur den Begriff eingegeben und dann suchen und dann auf weitersuchen.

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Robert
Geschrieben am: 15.10.2020 17:43:22

Könnte das eventuell mit ausgeblendeten Zellen zusammenhängen?

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Nepumuk
Geschrieben am: 15.10.2020 17:54:29

Hallo Robert,

ausgeblendete Zellen werden nicht durchsucht. Ich habe keine Ahnung was da schief läuft. Ich kann nur den Fehler abfangen.

Option Explicit

Private Sub CommandButton3_Click()
    Dim strSearch As String, strFirstAddress As String
    Dim objCell As Range, objWorksheet As Worksheet
    Dim blnAbort As Boolean, blnFound As Boolean
    strSearch = InputBox("Suchbegriff:", "Suche nach...")
    If strSearch <> vbNullString Then
        Do
            For Each objWorksheet In ThisWorkbook.Worksheets
                Set objCell = objWorksheet.Cells.Find(What:=strSearch, _
                    LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
                If Not objCell Is Nothing Then
                    strFirstAddress = objCell.Address(External:=True)
                    blnFound = True
                    Do
                        Call Application.Goto(Reference:=objCell)
                        If MsgBox("Weitersuchen?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then
                            blnAbort = True
                            Exit Do
                        End If
                        Set objCell = objWorksheet.Cells.FindNext(After:=objCell)
                        If objCell Is Nothing Then Exit Do
                    Loop Until objCell.Address(External:=True) = strFirstAddress
                End If
                If blnAbort Then Exit For
            Next
            If objCell Is Nothing And Not blnFound Then
                Call MsgBox("Suchbegriff nicht gefunden.", vbExclamation, "Hinweis")
                Exit Do
            ElseIf Not blnAbort Then
                If MsgBox("Letze Fundstelle." & vbLf & vbLf & "Nochmal von vorne?", _
                    vbQuestion Or vbYesNo, "Abfrage") = vbNo Then Exit Do
            End If
        Loop Until blnAbort
    End If
End Sub

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: Suchen und weitersuchen
von: Robert
Geschrieben am: 15.10.2020 18:28:27

Hallo Neupumuk!

Ich möchte mich ganz herzlich bei Dir bedanken. Jetzt geht auch die Suche nach Paditz. Also es funzt. Vielen Dank für Deine Mühe.


LG Robert