Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Suchen über alle Tabellen und anzeigen lassen
amintire
Hallo alle zusammen,
habe folgenden Code der angepasst werden müsste. Bei dem Code wird nur in der aktiven Tabelle gesucht, es soll aber in der ganzen Arbeitsmappe gesucht werden und wo der Eintrag gefunden wird (auch wenn es in mehrerern Tabellen vorhanden ist) anzeigen lassen, mit einem Link zu der Tabelle.
Hat jemand eine Idee ?
Lieben Gruß
Amina
'Sucht über die InputBox eingegebene Daten
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


		

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

Betreff
Benutzer
Anzeige
AW: Suchen über alle Tabellen und anzeigen lassen
11.11.2011 11:41:00
CitizenX
Hi,
noch eine Variante:
Code kommt in ein allgemeines Modul- Ausgabe der gefundenen Einträge erfolgt per Hyperlink in Spalte A des Aktiven Blattes.

Option Explicit
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

Grüße
Steffen
Anzeige
AW: Suchen über alle Tabellen und anzeigen lassen
11.11.2011 11:53:27
amintire
Hallo Mathias, hallo Steffen,
vielen Dank für eure Hilfe und den beiden Variationen.
Lieben Gruß
Amina
Korrektur ...
11.11.2011 22:00:07
Matthias
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
Anzeige

328 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige