308 Aufrufe
Gefragt in Tabellenkalkulation von
Bearbeitet

Hallo zusammen,

ich habe ein Makro mit dem ich über mehrere Tabellenblätter suchen kann. Mein Problem ist das mir eine Hervorhebung des Suchergbenisses nicht gelingen will. Es wäre cool wenn die gefundene Zelle Farblich hervorgehoben wäre, aber nur für Kurze zeit.

 Kann mir jemand weiterhelfen?

Hier das Makro mit dem ich Suche:

Sub Suche()

Dim strSUCH As String, ws As Integer, rng As Range, strNeu As String

Start:

Do

strSUCH = InputBox("Wonach wird gesucht?" & Chr(13) & "Artikelnummer, ID-Nummer,Bezeichnung oder Lagerplatz")

If strSUCH = "" Or Len(strSUCH) = 0 Then Exit Sub

Loop While Len(strSUCH) < 3

ws = 1

Do While ws <= Worksheets.Count

Sheets(ws).Select

Set rng = Cells.Find(What:=strSUCH, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

, SearchFormat:=False)

If rng Is Nothing And ws = Worksheets.Count Then

strNeu = MsgBox("Keine Begriff gefunden!" & Chr(13) & "Möchten sie erneut suchen?", vbYesNo)

If strNeu = vbNo Then

Exit Sub

Else

GoTo Start

End If

ElseIf rng Is Nothing And ws < Worksheets.Count Then

ws = ws + 1

Else

rng.Select

Exit Sub

End If

Loop

End Sub

Vielen Dank schon mal

5 Antworten

+1 Punkt
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Julian,

wenn du das gefundene Suchergebnisse nur für eine gewisse Zeit hervorheben willst, musst du dir bewusst sein, dass du damit für die Zeit des Hervorhebens den Computer beschäftigst, d.h. der Cursor dreht sich.

Ergänze nach rng.Select den folgenden Code

'Hintergrundfarbe ändern
rng.Interior.ColorIndex = 7
'5 Sekunden warten
Application.Wait Now + TimeValue("00:00:05")
'Hintergrundfarbe aus
rng.Interior.ColorIndex = 0


Schau einfach, welche Hintergrundfarbe dir am besten gefällt (Zahl zwischen 0 = keine und 56).

Gruß

M.O.

+1 Punkt
Beantwortet von beverly_ Experte (3.3k Punkte)

Hi Julian,

vielleicht hilft das hier weiter - es wird immer zur gefundenen Zelle gesprungen:

Dim rngZelle As Range
Dim strSUCH As String
Dim strNeu As String
Dim strStart As String
Dim bytWeiter As Byte
Dim lngTabellen As Long
Do
    strSUCH = InputBox("Wonach wird gesucht?" & Chr(13) & _
       "Artikelnummer, ID-Nummer,Bezeichnung oder Lagerplatz")
    If strSUCH <> "" Then
       For lngTabellen = 1 To Worksheets.Count
           With Worksheets(lngTabellen).UsedRange
               Set rngZelle = .Find(What:=strSUCH, LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, _
                   SearchDirection:=xlNext, MatchCase:=False, _
                   SearchFormat:=False)
               If Not rngZelle Is Nothing Then
                   strStart = rngZelle.Address
                   Do
                       Application.Goto reference:=rngZelle
                       bytWeiter = MsgBox("Weiter suchen?", vbOKCancel)
                       If bytWeiter = 2 Then Exit Do
                       Set rngZelle = .FindNext(rngZelle)
                   Loop While rngZelle.Address <> strStart
               End If
           End With
           If bytWeiter = 2 Then Exit Do
       Next lngTabellen
       If rngZelle Is Nothing Then
           strNeu = MsgBox("Keine Begriffe gefunden!" & Chr(13) & _
               "Möchten Sie erneut suchen?", vbYesNo)
           If strNeu = vbNo Then Exit Do
       End If
    Else
       Exit Do
    End If
    Set rngZelle = Nothing
Loop

Bis später, Karin

0 Punkte
Beantwortet von jc-f Einsteiger_in (12 Punkte)
Hallo M.O.

genau das wäre das richtige für mich.

Ich habe den Code jetzt ergänzt, aber jetzt bekomme ich einen Laufzeitfehler 1004. Anwednungs- oder objektdefinierter Fehler.

wie kann ich das Lösen?
+1 Punkt
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Julian,

so funktioniert der Code bei mir:

Sub Suche()

Dim strSUCH As String
Dim ws As Integer
Dim rng As Range
Dim strNeu As String

Start:

Do

strSUCH = InputBox("Wonach wird gesucht?" & Chr(13) & "Artikelnummer, ID-Nummer,Bezeichnung oder Lagerplatz")

If strSUCH = "" Or Len(strSUCH) = 0 Then Exit Sub

Loop While Len(strSUCH) < 3

  ws = 1

  Do While ws <= Worksheets.Count

     Sheets(ws).Select

     Set rng = Cells.Find(What:=strSUCH, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

     If rng Is Nothing And ws = Worksheets.Count Then

         strNeu = MsgBox("Keine Begriff gefunden!" & Chr(13) & "Möchten sie erneut suchen?", vbYesNo)

         If strNeu = vbNo Then

              Exit Sub

           Else

             GoTo Start

         End If

      ElseIf rng Is Nothing And ws < Worksheets.Count Then

         ws = ws + 1

      Else

        rng.Select
        'Hintergrundfarbe ändern
        rng.Interior.ColorIndex = 7
        '5 Sekunden warten
         Application.Wait Now + TimeValue("00:00:05")
        'Hintergrundfarbe aus
        rng.Interior.ColorIndex = 0
        Exit Sub

    End If

Loop

End Sub


Der Code sollte natürlich in einem allgemeinen Modul der Arbeitsmappe stehen.

Gruß

M.O.

0 Punkte
Beantwortet von jc-f Einsteiger_in (12 Punkte)
Ich habe es gerade in einem neuen Dokument ausprobiert, da geht es bei mir auch.

Vielen Dank für die Hilfe
...