Microsoft Excel

Herbers Excel/VBA-Archiv

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

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

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

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

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

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

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

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


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

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.

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.

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

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

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

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.

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

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

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

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