Office: Werte in ganzer Arbeitsmappe suchen und Treffer in Listbox ausgeben

Hallo, Ihr lieben Experten,

ich stehe leider wieder mal vor einem Problem, dass ich mit meinen bescheidenen Kenntnissen nicht auf die Reihe bringe.
Wenn die Sache laufen würde, würde mir das täglich viel Klickarbeit
ersparen, daher wende ich mal wieder an Euch, als Experten.

Ich habe beruflich Arbeitsmappen mir vielen Tabellenblättern und möchte die ganze Mappe oder nur die aktive Tabelle nach Wörten/Zeichenfolgen
durchsuchen und die Zeilen der Treffer in einer Listbox aufzeigen. Nach Klick auf eine Zeile in der Listbox soll zu dem entsprechenden
Blatt gewechselt werden und die ganze Zeile oder nur die Zelle A markiert werden.

Ich weiß natürlich das Excel eine solche, ähnliche Funktion in der Suche schon hat, aber ich möchte diese Suchmaske bei bestimmten Tabellen, die
ich mehrmals täglich brauche, gleich beim Öffnen mit aktivieren, damit ich dann nur den Suchtext eingeben kann und per Return auch gleich
suchen kann (und nicht erst Suche und dann nochmal alle Optionen einstellen).
Habe auch schon versucht die Excel-Suchfunktion per Makrorecorder aufzuzeichnen – das funktioniert leider nicht.

Habe mir einen entsprechenden Code aus dem Internet herausgesucht (der war eigentlich nur für das aktive Blatt gedacht) und diesen
entsprechend umgebaut – soweit meine Kenntnisse reichen
(Der Originalcode ist ganz unten im Code unter Sub Backup()).

Leider kann ich den eigentlichen Such Code nicht ganz nachvollziehen, daher bekomme ich folgende Probleme einfach nicht in den Griff:

>> Mein größtes Problem: Bei der Suche über die ganze Mappe: Wenn nur auf einem Tabellenblatt Suchergebnisse vorhanden sind, bzw. nur
ein Fund in der ganzen Mappe, funktioniert das wunderbar, wenn aber auf verschiedenen Blättern Suchergebnisse vorhanden sind, dann geht
der Code teilweise in eine Endlosschleife über (Ausstieg daraus: Taskmanager aufrufen, dann aktualisiert sich die Anzeige in der Listbox – dann
auf einen Eintrag klicken und vba bietet das Debuggen an…).
Vermute, das liegt irgendwie am Suchcode – aber da steige ich mit meinen bescheidenen VBA Kenntnissen leider nicht durch.
Hier in der Testtabelle kann ich z.B. Müller problemlos suchen, bei Huber komme ich meist in die Endlosschleife


>> Bei der Suche werden auch Ergebnisse aus Formeln nicht erkannt (hier z.B. das Alter 18). Geht das irgendwie zu machen? – ich meinte,
am Anfang ging es, wüsste aber nicht was ich deaktiviert haben könnte – vielleicht irre ich mich auch.

>> bei der Auflistung der Zelleninhalte in der Listbox werden auch Zeichen wie Zeilenumbruch mit angezeigt. Kann man die irgendwie rausfiltern?
(sieht man hier in der Testtabelle bei der Suche nach „17“).

Unten steht der gesamte Code, anbei auch eine Testmappe mit der UF (je nachdem was gewünscht ist).
Habe den Code, der die Titelleiste verbergen soll, auskommentiert, die Test-UF sollte also auf 32 und 64 Bit laufen (da muss ich immer
etwas ändern..).

Denke, so ein Tool könnte auch evtl. viele andere Nutzer interessieren und es wäre toll, wenn Ihr es zum Laufen brächtet.

In der Arbeit habe ich Office 2013 mit Win 7 32Bit, hier zu Hause Office 2016 Win 10 64 Bit – bei beiden Systemen ist es dasselbe


Im Voraus schon mal herzlichen Dank für Eure Mühe

(hoffe, ich habs nicht zu kompliziert gemacht...)



Das hier wäre der Code der UF:


Public TabZiel As String
Public ZeiZiel As String

Option Explicit

' 64 Bit Header... >>>>>>>>>>>>>>>>>>>
'Private Declare PtrSafe Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long

'Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long) As Long

'Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long

'Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal _
hwnd As Long) As Long

'Private Declare PtrSafe Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

'Private Declare PtrSafe Function ReleaseCapture Lib "user32" () As Long



' 32 Bit Header... >>>>>>>>>>>>>>>>>>>
'Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long

'Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long) As Long

'Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long

'Private Declare Function DrawMenuBar Lib "user32" (ByVal _
hwnd As Long) As Long

'Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

'Private Declare Function ReleaseCapture Lib "user32" () As Long


' restlicher Code für 64 und 32 Bit >>>>>>>>>>>>>>>>>>>>>
'Private Const GWL_STYLE As Long = -16
'Private Const WS_CAPTION As Long = &HC00000

'Private Const HTCAPTION = 2
'Private Const WM_NCLBUTTONDOWN = &HA1

'Private hWndForm As Long
'Private bCaption As Boolean










Private Sub UserForm_Initialize()
'If Val(Application.Version) >= 9 Then
'hWndForm = FindWindow("ThunderDFrame", Me.Caption)
'Else
'hWndForm = FindWindow("ThunderXFrame", Me.Caption)
'End If

'bCaption = False
'SetUserFormStyle
End Sub

Private Sub SetUserFormStyle()
'Dim frmStyle As Long

'If hWndForm = 0 Then Exit Sub

'frmStyle = GetWindowLong(hWndForm, GWL_STYLE)

'If bCaption Then
'frmStyle = frmStyle Or WS_CAPTION
'Else
'frmStyle = frmStyle And Not WS_CAPTION
'End If

'SetWindowLong hWndForm, GWL_STYLE, frmStyle

'DrawMenuBar hWndForm
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal _
Shift As Integer, ByVal X As Single, ByVal Y As Single)

'If hWndForm = 0 Then Exit Sub

'If Button = 1 Then
'ReleaseCapture
'SendMessage hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, 0
'End If
End Sub

Private Sub optCaptionOn_Click()
'bCaption = True
'SetUserFormStyle
End Sub

Private Sub optCaptionOff_Click()
'bCaption = False
'SetUserFormStyle
End Sub




' !!!!!!!!!!! Suchen Button mit Enter bestätigen folgendermaßen einschalten
' bei den Eigenschaften des Buttons "Default" auf True setzen....


Private Sub UserForm_Activate()


' bei Zweibildschirmvariante jeweils auf den Bildschirm ausrichten auf dem Excel aktiv ist (!!! sollten die gleiche Auflösung haben).
Dim sngTop As Single, sngLeft As Single
Me.StartUpPosition = 0
sngLeft = Application.Left + Application.Width / 2 - Me.Width / 2
sngTop = Application.Top + Application.Height / 2 - Me.Height / 2

Me.Left = sngLeft + 335
Me.Top = sngTop - 130



' Alt Position bei alter Userform
'Me.Left = sngLeft + 594
'Me.Top = sngTop - 69


' bestimmte Position beim Öffnen der Userform einnahmen
'Me.Left = 1176
'Me.Left = 2628
'Me.Top = 72
'Me.Top = 75

' Vorbelegung für Test...
'tb_Suche.value = "60317"


' Voreinstellung und sicherstellen, das immer nur eine Option aktiv ist...
chk_alles.Value = True
chk_aktiv.Value = False

' Voreinstellung und sicherstellen, das immer nur eine Option aktiv ist...
chk_mark_Zelle.Value = False
chk_mark_Zeile.Value = True


' anders gelöst - Button aber nur ausblenden soll erst mal behalten werden
com_Sprung.Visible = False


' Mitteilungsbox für nichts gefunden zunächst ausblenden
tb_nichts_gefunden.Visible = False


' in der Testtabelle soll nur in der aktiven Tabelle gesucht werden...
'If ActiveSheet.Name = "Test" Then MsgBox "toto" ' nur Test ob er das auch erkennt...
If ActiveWorkbook.Name = "Test.xlsm" Then
' Voreinstellung und sicherstellen, das immer nur eine Option aktiv ist...
chk_alles.Value = False
chk_aktiv.Value = True

End If


End Sub




Private Sub chk_aktiv_Click()
' Sicherstellen, das immer nur eine Option aktiv ist...

If chk_aktiv.Value = True Then
chk_alles.Value = False
End If


If chk_aktiv.Value = False Then
chk_alles.Value = True
End If



End Sub



Private Sub chk_alles_Click()
' Sicherstellen, das immer nur eine Option aktiv ist...

If chk_alles.Value = True Then
chk_aktiv.Value = False
End If


If chk_alles.Value = False Then
chk_aktiv.Value = True
End If



End Sub



Private Sub chk_mark_Zeile_Click()
' Sicherstellen, das immer nur eine Option aktiv ist...

If chk_mark_Zeile.Value = True Then
chk_mark_Zelle.Value = False
End If


If chk_mark_Zeile.Value = False Then
chk_mark_Zelle.Value = True
End If



End Sub



Private Sub chk_mark_Zelle_Click()
' Sicherstellen, das immer nur eine Option aktiv ist...

If chk_mark_Zelle.Value = True Then
chk_mark_Zeile.Value = False
End If


If chk_mark_Zelle.Value = False Then
chk_mark_Zeile.Value = True
End If


End Sub






Private Sub ListBox1_Click()

'Dim TabZiel As Variant - wurde am Anfang Publiziert...
'Dim ZeiZiel As String - wurde am Anfang Publiziert...

With Me.ListBox1
TabZiel = .List(.ListIndex, 8)
ZeiZiel = .List(.ListIndex, 9)
End With

' Test - nicht mehr notwendig
'MsgBox ("Tabelle: " & TabZiel & " Zeile: " & ZeiZiel)
'MsgBox ("A" & ZeiZiel)

' Sprung direkt durch Markieren des Eintrages in der Listbox...
Worksheets(TabZiel).Activate

If chk_mark_Zelle.Value = True Then
' markiert nur Zelle A der entsprechenden Zeile
Range("A" & ZeiZiel).Select
Range("A" & ZeiZiel).Activate
End If


If chk_mark_Zeile.Value = True Then
' markiert die ganze Zeile
Range("A" & ZeiZiel).EntireRow.Select
End If


End Sub



Private Sub com_Sprung_Click()

With Me.ListBox1
TabZiel = .List(.ListIndex, 8)
ZeiZiel = .List(.ListIndex, 9)
End With


' Test - nicht mehr notwendig
'MsgBox ("Tabelle: " & TabZiel & " Zeile: " & ZeiZiel)
'MsgBox ("A" & ZeiZiel)


Worksheets(TabZiel).Activate

If chk_mark_Zelle.Value = True Then
' markiert nur Zelle A der entsprechenden Zeile
Range("A" & ZeiZiel).Select
Range("A" & ZeiZiel).Activate
End If


If chk_mark_Zeile.Value = True Then
' markiert die ganze Zeile
Range("A" & ZeiZiel).EntireRow.Select
End If


End Sub




Private Sub com_Suche_Click()


Dim sheetNr As Long
Dim s As String
Dim Found As Range
Dim firstAddress As String
Dim I As Integer ' Zeile

Dim Tabelle As String
Dim Zeile As Variant

On Error Resume Next
I = 0






s = Trim(tb_Suche.Text) 'Sucheingabe über Textbox1 steuern
's = tb_Suche.value


' Prüfen ob Suchtext eingetragen wurde...
If s = "" Then
MsgBox ("Kein Suchtext Eingetragen!"), vbExclamation
Exit Sub

End If

ListBox1.Clear




' Suche durch die ganze Arbeitsmappe
If chk_alles.Value = True Then
For sheetNr = 1 To Worksheets.Count

With Worksheets(sheetNr)

s = tb_Suche.Value

' Tabellennamen und Zeilennummer auslesen für Sprung auf Inhalt
Tabelle = Worksheets(sheetNr).Name
Zeile = .Cells.Find(What:=s, LookAt:=xlPart).Row


Set Found = .Cells.Find(What:=s, LookAt:=xlPart)


' Kontrolle . nicht mehr notwendig
'MsgBox ("Found: " & Found)
'MsgBox Zeile



' Falls kein Suchtreffer - entsprechender Eintrag
If Zeile = "" Then

'ListBox1.AddItem
'ListBox1.List(0, 2) = "Nichts gefunden!"

' Mitteilungsbox für nichts gefunden einblenden
tb_nichts_gefunden.Visible = True
tb_nichts_gefunden.Value = "Kein Suchergebnis vorhanden!"


End If




If Not Found Is Nothing Then


' Mitteilungsbox für nichts gefunden bei erneuter Suche und Fund wieder ausblenden und Inhalt zurück setzen
tb_nichts_gefunden.Visible = True
tb_nichts_gefunden.Value = ""


firstAddress = Found.Address
'ListBox1.ColumnCount = 10 'Gibt die Werte der gefundenen Treffer an (Spaltenbezogen)
Do

ListBox1.AddItem Found
ListBox1.List(I, 1) = Worksheets(sheetNr).Cells(Found.Row, 1)
ListBox1.List(I, 2) = Worksheets(sheetNr).Cells(Found.Row, 2)
ListBox1.List(I, 3) = Worksheets(sheetNr).Cells(Found.Row, 3)
ListBox1.List(I, 4) = Worksheets(sheetNr).Cells(Found.Row, 4)
ListBox1.List(I, 5) = Worksheets(sheetNr).Cells(Found.Row, 5)
ListBox1.List(I, 6) = Worksheets(sheetNr).Cells(Found.Row, 6)
ListBox1.List(I, 7) = Worksheets(sheetNr).Cells(Found.Row, 7)
ListBox1.List(I, 8) = Tabelle
ListBox1.List(I, 9) = Zeile

' Zeile der nächsten Fundstelle ermitteln
Zeile = Cells.FindNext(After:=Found).Row

Set Found = Cells.FindNext(After:=Found)

' Kontrolle . nicht mehr notwendig
'MsgBox ("Found: " & Found)

' Kontrolle . nicht mehr notwendig
'MsgBox ("I: " & I)



I = I + 1
If Found.Address = firstAddress Then Exit Do


Loop


End If


End With


Next sheetNr




End If






' Suche nur für das aktive Tabellenblatt
If chk_aktiv.Value = True Then
With ActiveSheet


' Tabellennamen und Zeilennummer auslesen für Sprung auf Inhalt
'Tabelle = Worksheets(sheetNr).Name
Tabelle = ActiveSheet.Name ' funtioniert bei Suche auf aktiven Tabellenblatt nur so...
Zeile = .Cells.Find(What:=s, LookAt:=xlPart).Row

Set Found = .Cells.Find(What:=s, LookAt:=xlPart)



' Falls kein Suchtreffer - entsprechender Eintrag
If Zeile = "" Then

'ListBox1.AddItem
'ListBox1.List(0, 2) = "Nichts gefunden!"

' Mitteilungsbox für nichts gefunden einblenden
tb_nichts_gefunden.Visible = True
tb_nichts_gefunden.Value = "Kein Suchergebnis vorhanden!"


End If


If Not Found Is Nothing Then

' Mitteilungsbox für nichts gefunden bei erneuter Suche und Fund wieder ausblenden und Inhalt zurück setzen
tb_nichts_gefunden.Visible = True
tb_nichts_gefunden.Value = ""


firstAddress = Found.Address
ListBox1.ColumnCount = 10 'Gibt die Werte der gefundenen Treffer an (Spaltenbezogen)
Do


ListBox1.AddItem Found
ListBox1.List(I, 1) = .Cells(Found.Row, 1)
ListBox1.List(I, 2) = .Cells(Found.Row, 2)
ListBox1.List(I, 3) = .Cells(Found.Row, 3)
ListBox1.List(I, 4) = .Cells(Found.Row, 4)
ListBox1.List(I, 5) = .Cells(Found.Row, 5)
ListBox1.List(I, 6) = .Cells(Found.Row, 6)
ListBox1.List(I, 7) = .Cells(Found.Row, 7)
ListBox1.List(I, 8) = Tabelle
ListBox1.List(I, 9) = Zeile

' Zeile der nächsten Fundstelle ermitteln
Zeile = Cells.FindNext(After:=Found).Row

Set Found = Cells.FindNext(After:=Found)



'MsgBox Found

If Found.Address = firstAddress Then Exit Do
I = I + 1
Loop

End If


' Falls kein Suchtreffer
'If Found Is Nothing Then
'ListBox1.AddItem "---"
'ListBox1.List(I, 2) = "Nichts gefunden!"

'End If




End With

End If



' Cursor in Textbox tb_Suche setzen
'Zuweisungsliste_bearbeiten.tb_Nachname.SetFocus
tb_Suche.SetFocus





End Sub




Private Sub com_Ende_Click()

Unload Me

End Sub





Sub Backup()
' Original Code....

'Private Sub com_Suche_Click()


'Private Sub CommandButton1_Click() 'Anpassen
'Button Suchen

Dim s As String
Dim Found As Range
Dim firstAddress As String
Dim I As Integer ' Zeile
On Error Resume Next
I = 0

s = Trim(tb_Suche.Text) 'Sucheingabe über Textbox1 steuern
If s = "" Then Exit Sub
ListBox1.Clear

With ActiveSheet
Set Found = .Cells.Find(What:=s, LookAt:=xlPart)

If Not Found Is Nothing Then
firstAddress = Found.Address
ListBox1.ColumnCount = 10 'Gibt die Werte der gefundenen Treffer an (Spaltenbezogen)
Do
ListBox1.AddItem Found
ListBox1.List(I, 1) = Cells(Found.Row, 1)
ListBox1.List(I, 2) = Cells(Found.Row, 2)
ListBox1.List(I, 3) = Cells(Found.Row, 3)
ListBox1.List(I, 4) = Cells(Found.Row, 4)
ListBox1.List(I, 5) = Cells(Found.Row, 5)
ListBox1.List(I, 6) = Cells(Found.Row, 6)
ListBox1.List(I, 7) = Cells(Found.Row, 7)
ListBox1.List(I, 8) = Cells(Found.Row, 8)
Set Found = Cells.FindNext(After:=Found)
If Found.Address = firstAddress Then Exit Do
I = I + 1
Loop

End If
End With



' Cursor in Textbox tb_Suche setzen
'Zuweisungsliste_bearbeiten.tb_Nachname.SetFocus
tb_Suche.SetFocus



End Sub

:)

 

Hallo,

für ein erster Lesen und die Entscheidung, ob ich mich mit einem Thema beschäftigen möchte, setze ich max. 2 Minuten an. Zuwenig, um den Code auch nur zu überfliegen.

Eine Suche über alle Sheets sollte nicht mehr als 10-15 Code-Zeilen benötigen.

Vorschlag: Lade eine kleine Beispieldatei hoch, die z.B. zeigt, ob in Formeln, Datum oder ähnlichen Spezialfällen gesucht werden soll.

VG

 

Hallo

wenn ich Huber in die Suchmaske eingebe
bekomme ich 2 Einträge angezeigt ohne Endlosschleife

in Werten statt in Formeln sucht man so

Zeile = .Cells.Find(What:=s, LookAt:=xlPart, LookIn:=xlValues).Row


MfG Tom

 

Hallo Steve,

dieses Problem hättest du nicht, wenn du, wie es vernünftig wäre, die Daten nicht auf mehrere Blätter aufteilen würdest.

 

Hallo Steve,

bis auf das Umbruchzeichen konnte ich deine Probleme nicht reproduzieren. Das habe ich mit Excel 2010 und Excel 2016 getestet. Beide Versionen 16 Bit.

 

Zunächst einmal ganz herzlichen Dank für Deine schnelle Rückmeldung.

eine Beispieldatei war anhängend (und ist auch jetzt wieder leiche verändert anhängend) – sorry, war im Text leider erst später erwähnt
und ich gestehe, ich bin oft etwas weitschweifend

Es soll eigentlich in Formeln, Datum und Text gesucht werden. Wenn das nicht zu verbinden ist, wäre mir der Text am wichtigsten,
die Ergebnisse von Formeln auch sehr wichtig, das Datum schön, aber eher unwichtig


In der dieser Antwort beigefügten Datei habe ich das Problem nochmal versucht aufzuzeigen – das Blöde ist wirklich,
manchmal ist es da, manchmal auch nicht.
Wenn ich „Lister“ ist es sofort da, oft auch wenn ich zuerst „Müller“, dann „Huber“ suche, oder umgekehrt. Bisher immer, wenn ich „2000“
suche, das kann natürlich sein, weil es ein Datum ist.

Nochmals vielen Dank für Deine Hilfe und Mühe

 

Zunächst einmal ganz herzlichen Dank für Deine schnelle Rückmeldung.

Ich hab Deinen Code mal ausprobiert – ich finde jetzt z.B. einen Eintrag mit Alter 15,. Das ist super – es werden aber leider nicht
mehr alle Einträge mit 15 angezeigt (habe Deinen Code jetzt mit in die Beispieldatei, ist aber auskommentiert).
Kann ich nicht beides suchen? – oder müsste ich einen zweiten Durchlauf mit den Werten machen? – ein kurzer Test hat nicht
funktioniert… - werde mich aber morgen noch mal intensiv dran machen


Hab die Beispieldatei noch mal in der Antwort mit hochgeladen...

Nochmals vielen Dank für Deine Hilfe und Mühe

 

Klaus Dieter
Zunächst einmal ganz herzlichen Dank für Deine schnelle Rückmeldung.
(sehe gerade, ich habe Euch allen einzeln geantwortet, aber im Forum wird nicht angezeigt wem.
Ich schreibe jetzt mal die Namen dazu wem ich antworte ... - Sorry, bin da noch nicht so bewandert...)

Leider kann ich die Daten nicht auf ein Blatt bringen, da es nicht meine Daten sind (bzw. mit einigem Aufwand in eine
extra Datei schon, dieser Aufwand wäre aber zu groß, da sich die Originaldateien laufend ändern). Ich kann die Originaldaten mit den
ich arbeite leider hier nicht aufzeigen


Die Umbruchzeichen sind ein Schönheitsfehler, wär eben nur schön wenn man sie ausblenden könnte.

In der dieser Antwort beigefügten Datei habe ich das Problem nochmal versucht aufzuzeigen – das Blöde ist wirklich, manchmal ist es da, manchmal auch nicht.
Wenn ich „Lister“ ist es sofort da, oft auch wenn ich zuerst „Müller“, dann „Huber“ suche, oder umgekehrt. Bisher immer, wenn ich „2000“
suche, das kann natürlich sein, weil es ein Datum ist.

Könnte es sein, dass ich bei jeder Suche in einem neuen Blatt die Variablen zurücksetzen müsste?
Der Code hat ja die Ergebnisse des Vorblattes noch gespeichert, was ja vielleicht den Fehler erzeugt.

Hab mal

Found.Clear
firstAddress = ""
Zeile = ""
sheetNr = "" (nur bei komplett neuer Suche)

probiert, bringt aber leider nichts, der Fehler ist trotzdem da.

Nochmals vielen Dank für Deine Hilfe und Mühe

 

Hallo,

DAtei mit "Workbook_open"-Event und vielen API's hochzuladen ist unter Sicherheitsaspekten ein Alptraum!

Um alle Arbeitsbätter zu durchsuchen sollte die Kombination von 2 Schleifen reichen:

dim WS as worksheet
dim rng as range
for each WS in sheets
set rn = ws.usedrange.cells.find(Suchwort, alle Parameter
'Schleife für alle Treffer pro Seite =>siehe Range.find
next WS

Grüße

 

Hallo Phi.VBA

Erst einmal vielen, besten Dank. Habe Deinen Code in die Routine für die Suche in der ganzen Mappe eingebaut -
und es funktioniert prima. Keine Endlosschleifen mehr - zudem findet er jetzt auch noch die Ergebnisse aus den Formeln.

Konnte es kurz schon in der Arbeit mit den "richtigen" Tabellen testen - Klasse - "Passt, wackelt und hat Luft", wie
man bei uns so sagt.

Damit hast Du mir für die nächsten Jahre -hoffe meine Tätigkeit noch länger machen zu dürfen :-) - viel
Zeit und "Klick-Arbeit" gespart.

Dank natürlich an alle, die versucht haben mir zu helfen, ich weiß, solche "Ferndiagnosen" sind oft
sehr schwierig, vor allem wenn man das Problem vielleicht nicht nachvollziehen kann.

Falls der Code evtl. auch noch andere interessiert, habe ich die jetzt funktionierende Beispielmappe noch
mal mit hochgeladen, im Anschluss an diesen Text stelle ich hier auch noch mal den geänderten Code für die Suche
in der ganzen Arbeitsmappe ein für die, die fremde Mappen nicht runterladen können oder wollen.

Sorry, das vermutlich die Einrückungen wieder verloren gehen - hab da öfter mal Pech mit dem Einfügen...
Der Rest des Codes steht ja noch oben in dem Threat.

Ich werde dann den Threat schließen - Vielen herzlichen Dank nochmal für Deine Zeit und Hilfe


Hier der Code:

' Suche durch die ganze Arbeitsmappe >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
If chk_alles.Value = True Then

Dim WS As Worksheet

For Each WS In Sheets

s = tb_Suche.Value

' Tabellennamen und Zeilennummer auslesen für Sprung auf Inhalt
Tabelle = WS.Name
Zeile = WS.UsedRange.Cells.Find(What:=s, LookAt:=xlPart, LookIn:=xlValues).Row




Set Found = WS.UsedRange.Cells.Find(What:=s, LookAt:=xlPart, LookIn:=xlValues)


' Kontrolle . nicht mehr notwendig
'MsgBox ("Found: " & Found & " Tabelle: " & Tabelle & " Zeile: " & Zeile)




' Falls kein Suchtreffer - entsprechender Eintrag
If Zeile = "" Then

' Mitteilungsbox für nichts gefunden einblenden
tb_nichts_gefunden.Visible = True
tb_nichts_gefunden.Value = "Kein Suchergebnis vorhanden!"

End If




If Not Found Is Nothing Then

firstAddress = Found.Address
'ListBox1.ColumnCount = 10 'Gibt die Werte der gefundenen Treffer an (Spaltenbezogen)
Do

ListBox1.AddItem Found
ListBox1.List(I, 1) = WS.Cells(Found.Row, 1)
ListBox1.List(I, 2) = WS.Cells(Found.Row, 2)
ListBox1.List(I, 3) = WS.Cells(Found.Row, 3)
ListBox1.List(I, 4) = WS.Cells(Found.Row, 4)
ListBox1.List(I, 5) = WS.Cells(Found.Row, 5)
ListBox1.List(I, 6) = WS.Cells(Found.Row, 6)
ListBox1.List(I, 7) = WS.Cells(Found.Row, 7)
ListBox1.List(I, 8) = Tabelle
ListBox1.List(I, 9) = Zeile

' Zeile der nächsten Fundstelle ermitteln
Zeile = WS.UsedRange.Cells.FindNext(After:=Found).Row

Set Found = WS.UsedRange.Cells.FindNext(After:=Found)

' Kontrolle . nicht mehr notwendig
'MsgBox ("Found: " & Found & " I: " & I)


I = I + 1
If Found.Address = firstAddress Then Exit Do


Loop


End If


Next WS




End If