18.10.2018, 08:09
Hallo zusammen,
ich habe folgendes Problem, für welches ich schon einen Lösungsansatz habe:
Ich habe eine Arbeitsmappe mit über 100 Blättern, in welchen immer nach dem gleichen Schema Tabellen enthalten sind. Das erste Tabellenblatt heißt "Suche". Per VBA würde ich gerne eine Suche erstellen, in der man einen Begriff eingeben kann und dieser entsprechend in allen Blättern gesucht wird. Das erfüllt der folgende Code bereits. Das Problem ist nur, dass die Suche nach dem ersten gefundenen Begriff aufhört.
Ich hätte gerne, dass man per Tab o. Ä. von Blatt zu Blatt springen kann und der gesuchte Begriff markiert wird. Gibt es da eine Möglichkeit?
Danke im Voraus für eure Hilfe!
Mein bisheriger Code:
ich habe folgendes Problem, für welches ich schon einen Lösungsansatz habe:
Ich habe eine Arbeitsmappe mit über 100 Blättern, in welchen immer nach dem gleichen Schema Tabellen enthalten sind. Das erste Tabellenblatt heißt "Suche". Per VBA würde ich gerne eine Suche erstellen, in der man einen Begriff eingeben kann und dieser entsprechend in allen Blättern gesucht wird. Das erfüllt der folgende Code bereits. Das Problem ist nur, dass die Suche nach dem ersten gefundenen Begriff aufhört.
Ich hätte gerne, dass man per Tab o. Ä. von Blatt zu Blatt springen kann und der gesuchte Begriff markiert wird. Gibt es da eine Möglichkeit?
Danke im Voraus für eure Hilfe!
Mein bisheriger Code:
Code:
Option Explicit
Sub suchen()
Dim strSuch As String, ws As Integer, rng As Range, strNeu As String
Start:
Do
strSuch = InputBox("Wonach wird gesucht?" & Chr(13) & "Mindestens 3 Buchstaben angeben!")
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