Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.06.2024 22:07:02
25.06.2024 21:01:55
25.06.2024 19:21:44
Anzeige
Archiv - Navigation
1564to1568
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Exceldatei per Eingabefeld nach Inhalt durchsuchen

Exceldatei per Eingabefeld nach Inhalt durchsuchen
06.07.2017 12:59:53
Codexfree
Hallo liebe Experten,
ich habe folgendes Problem, bei welchem ich keine Lösung habe:
Ich möchte alle Exceldateien eines zuvor in einem Eingabefeld angegebenen Pfades und alle enthaltenen Tabellenblätter per "Freitextsuchfunktion" nach einem eingegebenen Suchbegriff durchsuchen.
Anschließend sollen bestimme Inhalte der Dateien als "Kurzfassung", sowie ein Hyperlink zu entsprechenden Dateien in einer neuen Exceldatei aufgelistet werden.
Von Ihrer Grundstruktur sind alle Dateien gleich aufgebaut.
Beispiel: im Eingabefeld wird "Test" eingegeben
Ergebnis: (es werden alle Dateien angezeigt, welche den Suchbegriff -egal wo- enthalten)
Userbild
Die Spaltenüberschriften (fett) entsprechen den Inhalten bestimmter Zellen des ersten Tabellenblattes, die Ergebnisse den Werten in der entsprechenden Zelle rechts daneben.
Ich hoffe, dass die Problembeschreibung ausreichend ist.
PS: Ich habe wenig bis keine Ahnung von VBA und das Erstellen von Eingabefeldern. Eine Accesdatenbank kommt hier nicht infrage, da diese vielen Dateien bereits existieren und der Import wegen der schlechten Datenanordnung ziemlich aufwendig wäre.
Besten Dank vorab für Eure Hilfe und viele Grüße
Codexfree

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Exceldatei per Eingabefeld nach Inhalt durchsuchen
06.07.2017 13:40:16
Michael
Hallo!
Teste mal folgenden Code, beachte aber die u.a. Voraussetzungen:
Sub a()
Dim WbZ As Workbook: Set WbZ = ThisWorkbook
Dim WsZ As Worksheet: Set WsZ = WbZ.Worksheets("Tabelle1")
Dim WbQ As Workbook, Ws As Worksheet
Dim Pfad$, Datei$, Such$, Treffer As Range, Felder, i&
Dim Hl As Range, f As Boolean: f = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Verzeichnis wählen"
.AllowMultiSelect = False
If .Show  -1 Then
MsgBox "Vorgang abgebrochen", vbInformation
Exit Sub
Else: Pfad = .SelectedItems(1) & "\"
End If
End With
Application.ScreenUpdating = False
Such = "Test"
Datei = Dir(Pfad & "*.xls*", vbDirectory)
Felder = Array("A1", "B2", "C3", "D4", "E5")
Do Until Dir = vbNullString
Set WbQ = Workbooks.Open(Datei)
For Each Ws In WbQ.Worksheets
Set Treffer = Ws.UsedRange.Find(Such, LookIn:=xlValues, _
lookat:=xlWhole)
If Not Treffer = Nothing Then
f = True: Exit For
End If
Next Ws
If f Then
With WsZ
For i = LBound(Felder) To UBound(Felder)
.Cells(.Rows.Count, i + 1).End(xlUp).Offset(1, 0) = _
WbQ.Worksheets(1).Range(Felder(i)).Offset(, 1)
Next i
Set Hl = .Cells(.Rows.Count, 6).End(xlUp).Offset(1, 0)
Hl.Hyperlinks.Add anchor:=Hl, Address:=Pfad & Datei
End With
WbQ.Close False
Else:
WbQ.Close False
End If
Datei = Dir
Loop
Set WbZ = Nothing: Set WsZ = Nothing: Set WbQ = Nothing
Set Ws = Nothing: Set Treffer = Nothing: Erase Felder
Set Hl = Nothing
End Sub
Voraussetzungen:
- Das Makro wird aus der Mappe aufgerufen, in der die Übersicht erstellt werden soll; das Tabellenblatt heißt bei mir "Tabelle1" (ggf. anpassen)
- Die Überschriftenzeile (Projektname, etc.) ist bereits auf dem Blatt vorhanden
- Gesucht wird in den Dateien immer nach dem Begriff der hier definiert wird
Such = "Test"
- Ich gehe davon aus, dass die Rubriken (Projektname etc.) immer in den gleichen Zellen stehen, auf dem ersten Tabellenblatt; hier werden diese Zellen vordefiniert - übertragen wird dann ggf. der Wert der in der Zelle rechts daneben steht (wie von Dir angegeben):
Felder = Array("A1", "B2", "C3", "D4", "E5")
- Code lässt sich von mir schlecht testen, weil ich mir Deine Dateiablage etc. nicht nachbaue(n kann).
Gib Bescheid!
Michael
Anzeige
AW: Exceldatei per Eingabefeld nach Inhalt durchsuchen
06.07.2017 15:25:19
Codexfree
Hallo Michael!
Erstmal Wow! und Danke! für die äußerst schnelle Lösung! :-)
Der Code funktioniert in großen Teilen, hat aber dennoch einige Fehler.
Nach der Verzeichnisauswahl kommt ein Laufzeitfehler "1004", eine bestimmte Datei wird nicht gefunden, obwohl sie vorhanden ist. Nach Verschieben der genannten Datei wird dann die nächste Datei genannt, usw...
Dieser Code wird beim Debuggen markiert:
Userbild
Nachdem ich ein Test-Unterverzeichnis mit lediglich 5 Dateien erstellt habe, hat es funktioniert.
Den Suchbegriff habe ich zum Testen abgeändert bzw. durch den Befehl "InputBox" variabel gemacht. Leider werden auch Dateien aufgelistet, die den Suchbegriff nicht enthalten, jedoch nicht alle des Verzeichnisses.
Nach einem Neustart von Excel funktioniert allerdings auch das Test-Unterverzeichnis nicht mehr und es kommt die gleiche Fehlermeldung 1004...
Und da bin ich mit meinem Laienhalbwissen auch schon am Ende. :/
Gruß
Codexfree
Anzeige
AW: Exceldatei per Eingabefeld nach Inhalt durchsuchen
06.07.2017 16:20:07
Michael
Hallo!
Sorry, da war ich schlampig, versuch mal so:
Sub a()
Dim WbZ As Workbook: Set WbZ = ThisWorkbook
Dim WsZ As Worksheet: Set WsZ = WbZ.Worksheets("Tabelle1")
Dim WbQ As Workbook, Ws As Worksheet
Dim Pfad$, Datei$, Such$, Treffer As Range, Felder, i&
Dim Hl As Range, f As Boolean: f = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Verzeichnis wählen"
.AllowMultiSelect = False
If .Show  -1 Then
MsgBox "Vorgang abgebrochen", vbInformation
Exit Sub
Else: Pfad = .SelectedItems(1) & "\"
End If
End With
Application.ScreenUpdating = False
Such = "Hallo"
Datei = Dir(Pfad & "*.xls*", vbDirectory)
Felder = Array("A1", "B2", "C3", "D4", "E5")
Do Until Datei = vbNullString
Set WbQ = Workbooks.Open(Pfad & Datei)
For Each Ws In WbQ.Worksheets
Set Treffer = Ws.UsedRange.Find(what:=Such, LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=True, _
searchformat:=False)
If Not Treffer Is Nothing Then
f = True: Exit For
End If
Set Treffer = Nothing
Next Ws
If f Then
With WsZ
For i = LBound(Felder) To UBound(Felder)
.Cells(.Rows.Count, i + 1).End(xlUp).Offset(1, 0) = _
WbQ.Worksheets(1).Range(Felder(i)).Offset(, 1)
Next i
Set Hl = .Cells(.Rows.Count, 6).End(xlUp).Offset(1, 0)
Hl.Hyperlinks.Add anchor:=Hl, Address:=Pfad & Datei
End With
WbQ.Close False
Else:
WbQ.Close False
End If
f = False
Datei = Dir
Loop
Set WbZ = Nothing: Set WsZ = Nothing: Set WbQ = Nothing
Set Ws = Nothing: Set Treffer = Nothing: Erase Felder
Set Hl = Nothing
End Sub
Klappt?
LG
Michael
Anzeige
AW: Exceldatei per Eingabefeld nach Inhalt durchsuchen
06.07.2017 16:51:25
Codexfree
Danke! :-)
Die o. g. Fehlermeldung ist nun weg. Aber jetzt findet das Makro einfach nichts mehr, bzw. es wird kein Ergebnis aufgelistet.
Wenn ich das Ganze mit allen Dateien teste, kommt irgendwann "Laufzeitfehler 5 ungültiger Prozeduraufruf oder Argument" beginnend mit der ersten Zeile von diesem Bereich:
Do Until Dir = vbNullString
Set WbQ = Workbooks.Open(Pfad & Datei)
For Each Ws In WbQ.Worksheets
Set Treffer = Ws.UsedRange.Find(what:=Such, LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=True, _
searchformat:=False)
If Not Treffer Is Nothing Then
f = True: Exit For
End If
Set Treffer = Nothing
Next Ws
If f Then
With WsZ
For i = LBound(Felder) To UBound(Felder)
.Cells(.Rows.Count, i + 1).End(xlUp).Offset(1, 0) = _
WbQ.Worksheets(1).Range(Felder(i)).Offset(, 1)
Next i
Set Hl = .Cells(.Rows.Count, 6).End(xlUp).Offset(1, 0)
Hl.Hyperlinks.Add anchor:=Hl, Address:=Pfad & Datei
End With
WbQ.Close False
Else:
WbQ.Close False
End If
Datei = Dir
Loop
LG
Codexfree
Anzeige
Was Du genau machst, weiß ich nicht, aber...
06.07.2017 17:24:36
Michael
Hallo Codex,
...ich weiß schon mal, dass Du nicht exakt meinen zuletzt geposteten Code verwendest.
Zunächst ist diese Zeile schlicht falsch
Do Until Dir = vbNullString
wie Du an meinem oben geposteten Code leicht erkennen kannst:
Do Until Datei = vbNullString
Außerdem fehlen Dir noch andere Codeteile meines zweiten Codes von oben. Ich weiß also nicht, was Du Dir da zusammenkopierst; so, wie ich den zweiten Code geschrieben haben verwendest Du ihn offenbar nicht.
Im Gegensatz zu meinem ersten Code ist mein zweiter mit einer Handvoll Dateien und zwei unterschiedlichen Verzeichnissen getestet; funktioniert bei mir, gem. Deiner Angaben, einwandfrei. Aber ich habe ja schon erwähnt, dass ich auf Deine konkreten Gegebenheiten schwer testen kann, da unbekannt.
Wie gesagt, aus meiner Sicht arbeitet mein zweiter Code korrekt; ich tue mir jetzt schwer Dir hier ferndiagnostisch zu helfen.
LG
Michael
Anzeige
AW: Was Du genau machst, weiß ich nicht, aber...
06.07.2017 18:06:40
Codexfree
Hallo Michael,
Du hast vollkommen Recht, da war ICH einfach schlampig. Dein Code funktioniert ganz hervorragend! :-)
Keine Fehlermeldung, Sucherebnisse werden angezeigt.
Mit einer Ausnahme (hier habe ich die Problemstellung aber vielleicht auch nicht korrekt beschrieben):
Es werden nur Ergebnisse aufgelistet, wenn der Suchbegriff exakt dem kompletten Zellinhalt entspricht. Sobald ein Suchbegriff in einer Zelle zwischen anderen Wörtern vorkommt, wird kein Ergebnis angezeigt.
LG
Codexfree
Sag ich ja 😉...
06.07.2017 18:33:59
Michael
Codex,
... freut mich aber natürlich, dass es passt.
Bzgl. exaktem Begriffsvorkommen, ändere hier
Set Treffer = Ws.UsedRange.Find(what:=Such, LookIn:=xlValues, _
lookat:=xlWhole, 
Das xlWhole in xlPart
Passt?!
Lg Michael
Anzeige
AW: Sag ich ja 😉...
06.07.2017 18:48:02
Codexfree
PERFEKT! :-D
Habe noch die Beachtung von Groß- und Kleinschreibung mit MatchCase:false abgestellt.
Ganz lieben Dank für deine superschnelle Hilfe und Muße mit mir Newbie!
Typen wie Dich braucht die Welt mehr!
Mach dir noch einen entspannten...
LG
Codexfree
Freut mich, Danke für die Rückmeldung, owT
06.07.2017 22:55:56
Michael

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige