Suchen und weitersuchen

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Suchen und weitersuchen

15 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)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread