642 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo zusammen,

ich habe eine Excel-Arbeitsmappe mit 6 Sheets. Alle Sheets werden mit einem Blattschutz belegt, damit nichts geändert werden kann. Leider funktioniert dann aber die Suchfunktion in Excel nicht mehr. Daher würde ich gerne ein Makro erstellen, dass bei der Tastenkombi Strg+F ein Suchfeld aufploppt "Bitte geben Sie Ihren Suchbegriff ein". Dann soll die Suche über alle Sheets durchgeführt werden und das Ergebnis ausgeben.

Könnt ihr mir da weiterhelfen?

Vielen, vielen Dank.

Viele Grüße
CR

1 Antwort

0 Punkte
Beantwortet von fedjo Experte (2.2k Punkte)
Hallo,
vielleicht so:

Option Explicit
Global SSearch As String
 Sub Suchen()
    Dim ws As Worksheet
    Dim c
    Dim firstAddress As String
    Dim secAddress
    Dim GFound As Boolean
    Dim GWeiter As Boolean
    
    GWeiter = False
    GFound = False
anf:
    SSearch = InputBox("Bitte geben Sie Ihren Suchbegriff ein:", "Suche in allen Sheets", SSearch)
    
    If SSearch = "" Then
        End
    End If
weiter:
    For Each ws In Worksheets
        'ws.Select
        With ws.Cells
            Set c = .Find(SSearch, LookIn:=xlValues, MatchCase:=False)
            If Not c Is Nothing Then
                GFound = True
                ws.Select
                c.Select
                firstAddress = c.Address
                If MsgBox("Weitersuchen ?", vbQuestion + vbYesNo) = vbYes Then
                    Do
                        Set c = .FindNext(c)
                        
                        
                        secAddress = c.Address
                        If c.Address = firstAddress Then
                            Exit Do
                        End If
                        c.Select
                        If MsgBox("Weitersuchen ?", vbQuestion + vbYesNo) = vbNo Then
                            GWeiter = True
                            GoTo ende
                        End If
                    Loop While Not c Is Nothing And secAddress <> firstAddress And c.Address <> firstAddress
                Else
                    GWeiter = True
                    GoTo ende
                End If
            End If
        End With
    Next ws
    
ende:

    If GFound = False Then
        If MsgBox("Suchwert nicht gefunden ! Neue Suche ?", vbInformation + vbYesNo) = vbYes Then
            GoTo anf:
        End If
    Else
        If GWeiter = False Then
            If MsgBox("Sie haben alle Tabellenblätter durchsucht ! Soll die Suche neu gestartet werden ?", vbInformation + vbYesNo) = vbYes Then
                GoTo weiter
            End If
        End If
    End If
        
End Sub

Gruß fedjo
...