Suchen über alle Tabellen und anzeigen lassen

Sub Suchen() Dim rngFind As Range Dim strFind As String strFind = InputBox("Daten eingeben:") If strFind = "" Then Exit Sub Set rngFind = Cells.Find(strFind, LookAt:=xlPart, LookIn:=xlFormulas) If rngFind Is Nothing Then Beep MsgBox "Daten wurden nicht gefunden!" Exit Sub End If rngFind.Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Suchen() Dim rngFind As Range, myFirstAdd, oSht As Object Dim strFind As String, oDict As Object, myKeys Dim i% strFind = InputBox("Daten eingeben:") If strFind = "" Then Exit Sub Set oDict = CreateObject("scripting.dictionary") For Each oSht In ThisWorkbook.Sheets If oSht.Name ActiveSheet.Name Then Set rngFind = oSht.Cells.Find(strFind, LookAt:=xlPart) If Not rngFind Is Nothing Then myFirstAdd = rngFind.Address Do oDict(rngFind.Parent.Name & "!" & rngFind.Address(0, 0)) = 0 Set rngFind = oSht.Cells.FindNext(rngFind) Loop Until myFirstAdd = rngFind.Address End If End If Next myKeys = oDict.Keys Cells(1, 1) = IIf(oDict.Count, "Suchbegriff: " & strFind & " gefunden in:", "Suchbegriff: " & _ strFind & " nicht gefunden!") Cells(2, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 1).ClearContents For i = LBound(myKeys) To UBound(myKeys) ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 2, 1), Address:="", _ SubAddress:=myKeys(i), TextToDisplay:=myKeys(i) Next Columns(1).AutoFit Set oDict = Nothing End Sub

Hallo
Sorry, Ich hatte ja nur den ersten Fund/Tabelle angezeigt.

Hier eine andere Variante:

Option Explicit
Sub Korrektur()
Dim MyRng As Range, X&
Dim MyStrg$
On Error Resume Next
MyStrg = InputBox("Bitte Suchbegriff eingeben", "Suche nach ...", "test")
If MyStrg = "" Then Exit Sub
If StrPtr(MyStrg) = 0 Then Exit Sub 'Abbrechen gedrückt
For X = 1 To Worksheets.Count
Worksheets(X).Activate
For Each MyRng In Cells.SpecialCells(xlCellTypeConstants)
If MyRng = MyStrg Then
MyRng.Select 'ist aber nicht unbedingt nötig
MsgBox "Fund in " & Worksheets(X).Name & "!" & MyRng.AddressLocal
End If
Next
Next
End Sub

oder ohne Acitvate

Option Explicit
Sub ml()
Dim MyRng As Range, X&
Dim MyStrg$
On Error Resume Next
MyStrg = InputBox("Bitte Suchbegriff eingeben", "Suche nach ...", "test")
If MyStrg = "" Then Exit Sub
If StrPtr(MyStrg) = 0 Then Exit Sub 'Abbrechen gedrückt
For X = 1 To Worksheets.Count
With Worksheets(X)
For Each MyRng In .Cells.SpecialCells(xlCellTypeConstants)
If MyRng = MyStrg Then
MsgBox "Fund in " & .Name & "!" & MyRng.AddressLocal
End If
Next
End With
Next
End Sub

Gruß Matthias

Beliebteste Forumthreads (12 Monate)

Suchen über alle Tabellen und anzeigen lassen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Suchen über alle Tabellen und anzeigen lassen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread