Excel 2007 - Mehrere Excel-Dateien nach einem Wert duchsuchen und dazugeh. Daten abspeichern
Guten Morgen!
Ich fall mal gleich mit der Tür ins Haus:
Ich möchte gerne 24 Dateien nach einem Wort durchsuchen und alle Werte die in der Zeile stehen, in der der Wert gefunden wurde, sollen in eine neue Excel-Datei abgespeichert werden.
Die Dateien haben jeweils ca. 40.000 Zeilen und sind je ca. 50MB groß. Die Dateinamen sind mit einem Jahr und einem Monat versehen ( "200801", "200802", "200803" bis "200912").
Außerdem sind die Dateien immer gleich aufgebaut (Spalte A= Name, Spalte B=Vorname, ...).
Gesucht werden soll nach dem Wert in Spalte U.
Ein Suchwort lautet z.B. "hans".
Nun kann es aber auch sein, dass in Spalte U "*hans" oder "hans müller" steht. Diese sollen natürlich auch gefunden werden.
Ein herauskopieren per Hand dauert deswegen auch viel zu lange.
Nun meine Frage: Wie kann man dies mit einem Makro ausführen?
PS: Mit Makros kenne ich mich noch nicht gut aus.
Über jede Anregungen würde ich mich sehr freuen.
Gruß
Ich fall mal gleich mit der Tür ins Haus:
Ich möchte gerne 24 Dateien nach einem Wort durchsuchen und alle Werte die in der Zeile stehen, in der der Wert gefunden wurde, sollen in eine neue Excel-Datei abgespeichert werden.
Die Dateien haben jeweils ca. 40.000 Zeilen und sind je ca. 50MB groß. Die Dateinamen sind mit einem Jahr und einem Monat versehen ( "200801", "200802", "200803" bis "200912").
Außerdem sind die Dateien immer gleich aufgebaut (Spalte A= Name, Spalte B=Vorname, ...).
Gesucht werden soll nach dem Wert in Spalte U.
Ein Suchwort lautet z.B. "hans".
Nun kann es aber auch sein, dass in Spalte U "*hans" oder "hans müller" steht. Diese sollen natürlich auch gefunden werden.
Ein herauskopieren per Hand dauert deswegen auch viel zu lange.
Nun meine Frage: Wie kann man dies mit einem Makro ausführen?
PS: Mit Makros kenne ich mich noch nicht gut aus.
Über jede Anregungen würde ich mich sehr freuen.
Gruß
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 137848
Url: https://administrator.de/contentid/137848
Ausgedruckt am: 08.11.2024 um 21:11 Uhr
37 Kommentare
Neuester Kommentar
Hallo user1234!
Hier mal ein ein kleines ausbaufähiges Beispiel.
Funktion:
Suchbegriff per InputBox abfragen
Eine neue Arbeitsmappe erstellen
Alle Dateien von Monat bis Monat durchsuchen und Zeile un neue Mappe kopieren
In diesem Code wird ein Suchbegriff nur einmal pro Monats-Mappe gefunden und kann bei Bedarf um eine Next-Such-Funktion erweitert werden. Die Suchfunktion findet aktuell alles, was den Suchtext beinhaltet, also "hans" findet z.B "Hans Meier" und "Chanselisee". Falls doch lieber eine explizite Suche erfolgen soll, dann den Parameter [xlPart] durch [xlWhole] ersetzen.
Quellcode im VB-Editor in ein Modul kopieren und die Konstanten entsprechend anpassen:
Gruß Dieter
[edit] Codezeile 38 geändert. Test ob Dateiname numerisch ist hinzugefügt[/edit]
Hier mal ein ein kleines ausbaufähiges Beispiel.
Funktion:
Suchbegriff per InputBox abfragen
Eine neue Arbeitsmappe erstellen
Alle Dateien von Monat bis Monat durchsuchen und Zeile un neue Mappe kopieren
In diesem Code wird ein Suchbegriff nur einmal pro Monats-Mappe gefunden und kann bei Bedarf um eine Next-Such-Funktion erweitert werden. Die Suchfunktion findet aktuell alles, was den Suchtext beinhaltet, also "hans" findet z.B "Hans Meier" und "Chanselisee". Falls doch lieber eine explizite Suche erfolgen soll, dann den Parameter [xlPart] durch [xlWhole] ersetzen.
Quellcode im VB-Editor in ein Modul kopieren und die Konstanten entsprechend anpassen:
Option Explicit
Option Compare Text
Const SuchPfad = "E:\Test" 'Monats-Mappen Ordnerpfad
Const SuchSheet = "Tabelle1" 'Monats-Mappen Tabellenname
Const NeueMappe = "E:\Test\Neu.xls" 'Neue Mappe Pfad
Const StartZeile = 2 'Neue Mappe Startzeile
Const SuchSpalte = "U" 'Monats-Mappen Spalte Suchen
Const SucheVon = "200801" 'Monats-Mappen Von Mappe
Const SucheBis = "200912" 'Monats-Mappen Bis Mappe
Const Msg = "Der angegebene Ordner existiert nicht!"
Sub GetExternData()
Dim Wkb0 As Workbook, Wks0 As Worksheet, WksX As Worksheet, NextLine As Long
Dim Fso As Object, Folder As Object, File As Object, c As Range, Search As String
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler": Exit Sub
Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen")
If Search = "" Then Exit Sub
Workbooks.Add: Set Wkb0 = ActiveWorkbook: Set Wks0 = Wkb0.Sheets(1)
Set Folder = Fso.GetFolder(SuchPfad)
NextLine = StartZeile
Application.ScreenUpdating = False
For Each File In Folder.Files
If LCase(Fso.GetExtensionName(File)) = "xls" And IsNumeric(Fso.GetBaseName(File)) = True Then
If Fso.GetBaseName(File) >= SucheVon And Fso.GetBaseName(File) <= SucheBis Then
Set WksX = GetObject(File.Path).Sheets(SuchSheet)
Set c = WksX.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
WksX.Rows(c.Row).Copy Destination:=Wks0.Cells(NextLine, 1)
NextLine = NextLine + 1
End If
GetObject(File.Path).Close False
End If
End If
Next
Wkb0.SaveAs NeueMappe: Wkb0.Close
Application.ScreenUpdating = True
End Sub
Gruß Dieter
[edit] Codezeile 38 geändert. Test ob Dateiname numerisch ist hinzugefügt[/edit]
Hallo user1234!
Gruß Dieter
Zitat von @user1234:
Beim ersten ausführen kam eine Fehlermeldung: Systemfehler &H80004005 (-214767259).
Diese bestätigte ich mit "Ok" und er zeigte mir die korrekten Daten bis ca. 200806 an.
Hast Du das Makro in einer seperaten Datei eingefügt, also nicht in die Datei, die in der Konstanten neue Mappe angegeben ist, sonder in eine seperate Datei, die nur das Makro enthält. Das Makro erstellt dann jeweils diese Neue Arbeitsmappe ohne Makro und fügt nur die Suchergebnisse in die Mappe ein.Beim ersten ausführen kam eine Fehlermeldung: Systemfehler &H80004005 (-214767259).
Diese bestätigte ich mit "Ok" und er zeigte mir die korrekten Daten bis ca. 200806 an.
Nach mehreren weiteren Tests funktioniert das Makro und es kommt keine Fehlermeldung mehr.
Jetzt brauch ich nur noch alle Datensätze aus den jeweiligen Dateien.
Das habe ich mir doch gedacht! Das dauert noch ein bisschen, bin gerade etwas im StressJetzt brauch ich nur noch alle Datensätze aus den jeweiligen Dateien.
Gruß Dieter
Hallo user1234!
Neuer Code mit Find-Next-Funktion:
Gruß Dieter
[edit] Codezeile 38 geändert. Test ob Dateiname numerisch ist hinzugefügt[/edit]
Neuer Code mit Find-Next-Funktion:
Option Explicit
Option Compare Text
Const SuchPfad = "E:\Test" 'Monats-Mappen Ordnerpfad
Const SuchSheet = "Tabelle1" 'Monats-Mappen Tabellenname
Const NeueMappe = "E:\Test\Neu.xls" 'Neue Mappe Pfad
Const StartZeile = 2 'Neue Mappe Startzeile
Const SuchSpalte = "U" 'Monats-Mappen Spalte Suchen
Const SucheVon = "200801" 'Monats-Mappen Von Mappe
Const SucheBis = "200912" 'Monats-Mappen Bis Mappe
Const Msg = "Der angegebene Ordner existiert nicht!"
Sub GetExternData()
Dim Wkb0 As Workbook, Wks0 As Worksheet, WksX As Worksheet, NextLine As Long, FirstAddress As String
Dim Fso As Object, Folder As Object, File As Object, c As Range, Search As String
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler": Exit Sub
Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen")
If Search = "" Then Exit Sub
Workbooks.Add: Set Wkb0 = ActiveWorkbook: Set Wks0 = Wkb0.Sheets(1)
Set Folder = Fso.GetFolder(SuchPfad)
NextLine = StartZeile
Application.ScreenUpdating = False
For Each File In Folder.Files
If LCase(Fso.GetExtensionName(File)) = "xls" And IsNumeric(Fso.GetBaseName(File)) = True Then
If Fso.GetBaseName(File) >= SucheVon And Fso.GetBaseName(File) <= SucheBis Then
Set WksX = GetObject(File.Path).Sheets(SuchSheet)
Set c = WksX.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
FirstAddress = c.Address
Do: WksX.Rows(c.Row).Copy Destination:=Wks0.Cells(NextLine, 1)
NextLine = NextLine + 1
Set c = WksX.Columns(SuchSpalte).FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
GetObject(File.Path).Close False
End If
End If
Next
Wkb0.SaveAs NeueMappe: Wkb0.Close
Application.ScreenUpdating = True
End Sub
Gruß Dieter
[edit] Codezeile 38 geändert. Test ob Dateiname numerisch ist hinzugefügt[/edit]
Hallo user1234!
Tja, das sind so die Feinheiten.
Also, die Suchfunktion entspricht der Suchfunktion, die Dir auch in der Excel-Ansicht zur Verfügung steht. D.h., wenn Du hinter Hans noch ein Leerzeichen oder einen Bindestrich mit eintippst, dann sollte Dir die Suchfunktion die gewünschten Ergebnisse liefern
Gruß Dieter
Tja, das sind so die Feinheiten.
Also, die Suchfunktion entspricht der Suchfunktion, die Dir auch in der Excel-Ansicht zur Verfügung steht. D.h., wenn Du hinter Hans noch ein Leerzeichen oder einen Bindestrich mit eintippst, dann sollte Dir die Suchfunktion die gewünschten Ergebnisse liefern
Gruß Dieter
Hallo user1234!
Yepp, gern geschehen
Gruß Dieter
Yepp, gern geschehen
Du hast mir sehr viel Arbeit erspart!
Das kann ich mir sehr gut vorstellen!Gruß Dieter
Hallo Dieter!
Ich habe eigentlich genau die gleiche Anwendung wie user1234. Da passt deine Lösung hervorragend.
Ich habe nur ein kleines Problem. Meine Dateien heißen "Inhaltsverzeichnis01 Atlas" bis "Inhaltsverzeichnis22 Atlas".
Was muss ich bei "SucheVon" und "SucheBis" eintragen dass er diese Dateien findet?
Dein Lösungsvorschlag ist echt genial, vielen Dank dafür.
Grüße von maierse
Ich habe eigentlich genau die gleiche Anwendung wie user1234. Da passt deine Lösung hervorragend.
Ich habe nur ein kleines Problem. Meine Dateien heißen "Inhaltsverzeichnis01 Atlas" bis "Inhaltsverzeichnis22 Atlas".
Was muss ich bei "SucheVon" und "SucheBis" eintragen dass er diese Dateien findet?
Dein Lösungsvorschlag ist echt genial, vielen Dank dafür.
Grüße von maierse
Hallo maierse!
Wobei zunächst zu klären wäre, ob bei Deinem Problem tatsächlich eine Suche von/bis erforderlich ist, oder ob eventuell alle Dateien durchsucht werden sollen, die den Text "Inhaltsverzeichnis" und "Atlas" enthalten? Beispiel für Suchmuster: "Inhaltsverzeichnis*Atlas" oder "Inhaltsverzeichnis## Atlas" (# steht für eine beliebige Ziffer).
Gruß Dieter
Wobei zunächst zu klären wäre, ob bei Deinem Problem tatsächlich eine Suche von/bis erforderlich ist, oder ob eventuell alle Dateien durchsucht werden sollen, die den Text "Inhaltsverzeichnis" und "Atlas" enthalten? Beispiel für Suchmuster: "Inhaltsverzeichnis*Atlas" oder "Inhaltsverzeichnis## Atlas" (# steht für eine beliebige Ziffer).
Gruß Dieter
Hallo maierse!
Sorry, aber irgendwie ist mir die Sache immer noch nicht ganz klar. Bedeutet das jetzt, dass z.B. alle Dateien in einem Ordner oder alle Dateien, die am Anfang den Text "Inhaltsverzeichnis*" beinhalten oder...?
Gruß Dieter
Sorry, aber irgendwie ist mir die Sache immer noch nicht ganz klar. Bedeutet das jetzt, dass z.B. alle Dateien in einem Ordner oder alle Dateien, die am Anfang den Text "Inhaltsverzeichnis*" beinhalten oder...?
Gruß Dieter
Hallo maierse!
Scheinbar reden wir aneinander vorbei Von daher werden alle Dateien dessen Dateiname den Text "Inhaltsverzeichnis" enthält z.B "Inhaltsverzeichnis 15 Atlas.xls" durchsucht.
Konstanten entsprechend anpassen:
Wobei die Neue Mappe zuvor gelöscht wird, falls diese schon existiert.
Gruß Dieter
Scheinbar reden wir aneinander vorbei Von daher werden alle Dateien dessen Dateiname den Text "Inhaltsverzeichnis" enthält z.B "Inhaltsverzeichnis 15 Atlas.xls" durchsucht.
Konstanten entsprechend anpassen:
Option Explicit
Option Compare Text
Const SuchPfad = "E:\Test" 'Such-Ordnerpfad
Const SuchFiles = "Inhaltsverzeichnis*.xls" 'Such-Dateien
Const SuchSheet = "Tabelle1" 'Such-Tabellenname
Const SuchSpalte = "U" 'Such-Spalte
Const NeueMappe = "E:\Test\Neu.xls" 'Neue Mappe Pfad
Const StartZeile = 2 'Neue Mappe Startzeile
Const Msg = "Der angegebene Ordner existiert nicht!"
Sub GetExternData()
Dim Wkb0 As Workbook, Wks0 As Worksheet, WksX As Worksheet, NextLine As Long, FirstAddress As String
Dim Fso As Object, File As Object, c As Range, Search As String
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler": Exit Sub
If Fso.FileExists(NeueMappe) = True Then Fso.DeleteFile NeueMappe
Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen")
If Search = "" Then Exit Sub
Workbooks.Add: Set Wkb0 = ActiveWorkbook: Set Wks0 = Wkb0.Sheets(1)
NextLine = StartZeile
Application.ScreenUpdating = False
For Each File In Fso.GetFolder(SuchPfad).Files
If File.Name Like SuchFiles Then
Set WksX = GetObject(File.Path).Sheets(SuchSheet)
Set c = WksX.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
FirstAddress = c.Address
Do: WksX.Rows(c.Row).Copy Destination:=Wks0.Cells(NextLine, 1)
NextLine = NextLine + 1
Set c = WksX.Columns(SuchSpalte).FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
GetObject(File.Path).Close False
End If
Next
Wkb0.SaveAs NeueMappe: Wkb0.Close
Application.ScreenUpdating = True
End Sub
Gruß Dieter
Hallo maierse!
Jepp, gern geschehen
Gruß Dieter
Jepp, gern geschehen
Gruß Dieter
Hallo Dieter,
ich habe änliches Problem mit dem Suchen in mehreren Dateien. Ich habe deinen Code an "maierse" als Makro gespeichert aber er funktioniert leider nur bis zum Zeile " Set WksX = GetObject(File.Path).Sheets(SuchSheet) ". An dieser Stelle bekomme ich eine Meldung " Laufzeitfehler'9': Index außerhalb des gültigen Bereiches ". Ich bin wirklich einer Anfänger, deshalb sagt mir diese Fehlermeldung nichts. Ich habe Windows7/64 und Excel 2010. Ich habe mehrere Excel Dateien im einem Ordner und jede Mappe besteht aus verschiedener Tabellenzahl z.B. von 1 bis 10, wo ich nach einem Text in der Spalte A suchen möchte und das Ergebnis in eine neue Tabelle mit Dateinamen und Tabellennamen kopiert wird. Z.B.: Dateiname: " Linie - Sensitive " besteht aus mereren Tabelen die auch eiginen Produktnamen haben und so ist in jeder Datei. Das Ergebnis soll so aussehen: gesuchte Komponent z.B Alkohol ist in "Linie - Sensitive" in Produkt " Day Cream " gefunden und so weiter.
Vielen Dank für deine Hilfe.
Max.
ich habe änliches Problem mit dem Suchen in mehreren Dateien. Ich habe deinen Code an "maierse" als Makro gespeichert aber er funktioniert leider nur bis zum Zeile " Set WksX = GetObject(File.Path).Sheets(SuchSheet) ". An dieser Stelle bekomme ich eine Meldung " Laufzeitfehler'9': Index außerhalb des gültigen Bereiches ". Ich bin wirklich einer Anfänger, deshalb sagt mir diese Fehlermeldung nichts. Ich habe Windows7/64 und Excel 2010. Ich habe mehrere Excel Dateien im einem Ordner und jede Mappe besteht aus verschiedener Tabellenzahl z.B. von 1 bis 10, wo ich nach einem Text in der Spalte A suchen möchte und das Ergebnis in eine neue Tabelle mit Dateinamen und Tabellennamen kopiert wird. Z.B.: Dateiname: " Linie - Sensitive " besteht aus mereren Tabelen die auch eiginen Produktnamen haben und so ist in jeder Datei. Das Ergebnis soll so aussehen: gesuchte Komponent z.B Alkohol ist in "Linie - Sensitive" in Produkt " Day Cream " gefunden und so weiter.
Vielen Dank für deine Hilfe.
Max.
Hallo Max!
Der bisherige Code ist auf die Suche in einem bestimmten Tabellenblatt (SuchSheet) ausgerichtet und kann mit Deinen Ablaufbedingungen nicht funktionieren.
Versuchs mal hiermit (Pfade entsprechend anpassen):
Gruß Dieter
Der bisherige Code ist auf die Suche in einem bestimmten Tabellenblatt (SuchSheet) ausgerichtet und kann mit Deinen Ablaufbedingungen nicht funktionieren.
Versuchs mal hiermit (Pfade entsprechend anpassen):
Option Explicit
Option Compare Text
Const SuchPfad = "X:\Test" 'Such-Ordnerpfad
Const SuchName = "*.xls*" 'Such-Dateien (Wildcards erlaubt)
Const SuchSpalte = "A" 'Such-Spalte
Const NeueMappe = "X:\Test\Ergebnis" 'Neue Mappe Pfad (ohne .xls/.xlsx)
Const TitelZeile = "Dateiname,Produkt,Suchbegriff" 'Neue Mappe Überschrift in Zeile 1
Const StartZeile = 2 'Neue Mappe Einträge ab Zeile 2
Const Msg = "Der angegebene Ordner existiert nicht!"
Sub GetExternData()
Dim Wkb0 As Workbook, WkbX As Workbook, Wks0 As Worksheet, Wks As Worksheet
Dim Fso As Object, File As Object, Found As Range, Search As String, NextLine As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler": Exit Sub
Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen")
If Search = "" Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Add: Set Wkb0 = ActiveWorkbook: Set Wks0 = Wkb0.Sheets(1)
With Wks0.Range("A1:C1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Value = Split(TitelZeile, ",")
End With
NextLine = StartZeile
For Each File In Fso.GetFolder(SuchPfad).Files
If File.Name Like SuchName And Not File.Path Like NeueMappe & ".xls*" Then
Set WkbX = GetObject(File.Path)
For Each Wks In WkbX.Worksheets
If Not Wks.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart) Is Nothing Then
With Wks0.Rows(NextLine)
.Columns("A") = File.Name
.Columns("B") = Wks.Name
.Columns("C") = Search
NextLine = NextLine + 1
End With
End If
Next
WkbX.Close False
End If
Next
Wks0.Columns("A:C").AutoFit
With Wkb0
.Application.DisplayAlerts = False
.SaveAs NeueMappe, xlNormal
.Application.DisplayAlerts = True
.Close False
End With
Application.ScreenUpdating = True
End Sub
Gruß Dieter
Hallo Dieter,
vielen Dank Dir für so schnelle Antwort. Das Ergebnis ist genau das was ich wollte. Nur die Suche wurde nur in einer Datei durchgeführt wo das Makro gespeihert ist. Die anderen 15 Datein sind unberührt geblieben. Das Sinn der Sache ist das alle Datein anhang das Makro gleichzeitig durchgesucht werden. Wäre es möglich dieses Problem zu lösen?? Ich wäre Dir sehr dankbar .
Vielen Dank nochmal für Deine Hilfe!!!
Mit freundlichen Grüßen.
Max.
vielen Dank Dir für so schnelle Antwort. Das Ergebnis ist genau das was ich wollte. Nur die Suche wurde nur in einer Datei durchgeführt wo das Makro gespeihert ist. Die anderen 15 Datein sind unberührt geblieben. Das Sinn der Sache ist das alle Datein anhang das Makro gleichzeitig durchgesucht werden. Wäre es möglich dieses Problem zu lösen?? Ich wäre Dir sehr dankbar .
Vielen Dank nochmal für Deine Hilfe!!!
Mit freundlichen Grüßen.
Max.
Hallo Max!
Die Datei mit dem Makro darf sich nicht im gleichen Verzeichnis, wie die anderen Dateien befinden, da ja nach allen Dateien (*.xls*) gesucht wird. Idealerweise sollte sich auch die Ergebnis-Datei in einem anderen Verzeichnis befinden.
Gruß Dieter
Die Datei mit dem Makro darf sich nicht im gleichen Verzeichnis, wie die anderen Dateien befinden, da ja nach allen Dateien (*.xls*) gesucht wird. Idealerweise sollte sich auch die Ergebnis-Datei in einem anderen Verzeichnis befinden.
Gruß Dieter
Hallo Max!
Verstehe ich nicht, bei mir läuft's einwandfrei
Was steht bei dir in den Konstanten: SuchPfad und NeueMappe
Und der Suchbegriff existiert auch in mindestens einer Such-Mappe in Spalte A?
Sind das *.xls- oder *.xlsx-Dateien?
Gruß Dieter
Verstehe ich nicht, bei mir läuft's einwandfrei
Was steht bei dir in den Konstanten: SuchPfad und NeueMappe
Und der Suchbegriff existiert auch in mindestens einer Such-Mappe in Spalte A?
Sind das *.xls- oder *.xlsx-Dateien?
Gruß Dieter
Hallo Dieter,
die Konstanten:- SuchPfad hat " C:\Users\XXX\Documents\Excel\YYY\Test ", wo sich alle Dateien ".*.xls "und ".*.xlsx." befinden.
-NeueMappe hat " C:\BOOK\Ergebnis ", wo sich keine einzige ".*. xls* " Dateien befindet.
Suchbegriff existiert mindenstens in einer Tabelle in Spalte A.
Ich habe sowohl Dateien "*.xls " als auch " *.xlsx ".
Ich habe mehrmals nach verschiedener Art und Weise ausprobiert aber das Ergebnis bleibt unverändert ( leere Excel Fenster).
Ich weiß wirklich nicht waran das liegr???
Mfg. Max
die Konstanten:- SuchPfad hat " C:\Users\XXX\Documents\Excel\YYY\Test ", wo sich alle Dateien ".*.xls "und ".*.xlsx." befinden.
-NeueMappe hat " C:\BOOK\Ergebnis ", wo sich keine einzige ".*. xls* " Dateien befindet.
Suchbegriff existiert mindenstens in einer Tabelle in Spalte A.
Ich habe sowohl Dateien "*.xls " als auch " *.xlsx ".
Ich habe mehrmals nach verschiedener Art und Weise ausprobiert aber das Ergebnis bleibt unverändert ( leere Excel Fenster).
Ich weiß wirklich nicht waran das liegr???
Mfg. Max
Hallo Max!
Also, ich habe kein Excel 2010. Von daher die Frage: Wenn Du Excel normal öffnest, wird dann eine Mappe mit einem leeren Tabellenblatt angezeigt?
Füge mal spaßeshalber in Codzeile 60 diese Zeile ein:
Gruß Dieter
Also, ich habe kein Excel 2010. Von daher die Frage: Wenn Du Excel normal öffnest, wird dann eine Mappe mit einem leeren Tabellenblatt angezeigt?
Füge mal spaßeshalber in Codzeile 60 diese Zeile ein:
Wks0.Visible = True |
Gruß Dieter
Hallo Dieter,
wenn ich Excel aufzumache, erscheint gans normale Excel Fenster.
Wenn ich das Makro laufen lasse dann sehe ich in der Leiste unten neue "geofftene" Mappe aber nur für kurze Zeit. Nach der Ende einer Durchsuchung ich muß manuell die Tabelle "Ergebnis " aufmachen und da finde ich keine gefilterte Daten. Da ist gans und garnicht.
Die Codezeile habe ich ergänzt. Ohne Erfolg.
Vielen Dank für Deine Unterstützung.
Mfg. Max
wenn ich Excel aufzumache, erscheint gans normale Excel Fenster.
Wenn ich das Makro laufen lasse dann sehe ich in der Leiste unten neue "geofftene" Mappe aber nur für kurze Zeit. Nach der Ende einer Durchsuchung ich muß manuell die Tabelle "Ergebnis " aufmachen und da finde ich keine gefilterte Daten. Da ist gans und garnicht.
Die Codezeile habe ich ergänzt. Ohne Erfolg.
Vielen Dank für Deine Unterstützung.
Mfg. Max
Hallo Max!
Kann ich leider nicht nachvollziehen, habe eventuell noch ne andere Idee. Aber setze zunächst mal ein Kommentarzeichen (') in die Codezeile 65, also:
Dann bleibt die Ergebnis-Datei am Ende geöffnet. Sieht man nun eine Tabelle?
Wenn's nicht geht, dann schreibe ich das Makro so um (Morgen), dass sich die Makro-Funktion und die Ergebnistabelle in eine Arbeitsmappe befinden. Sind doch aktuell zwei seperate Arbeitsmappen oder?
Gruß Dieter
Kann ich leider nicht nachvollziehen, habe eventuell noch ne andere Idee. Aber setze zunächst mal ein Kommentarzeichen (') in die Codezeile 65, also:
' .Close False |
Wenn's nicht geht, dann schreibe ich das Makro so um (Morgen), dass sich die Makro-Funktion und die Ergebnistabelle in eine Arbeitsmappe befinden. Sind doch aktuell zwei seperate Arbeitsmappen oder?
Gruß Dieter
Hallo Max!
Hier ein neuer Code. Wobei der Makro-Code und die Suchergebnisse in einer Arbeitsmappe zusammengefasst sind. Diese Mappe darf sich auch in dem Such-Verzeichnis befinden.
Der Inhalt des Tabellenblatts wird vor jeder neuen Suche gelöscht.
Gruß Dieter
[Edit] Codezeile 42 geändert [/Edit]
Hier ein neuer Code. Wobei der Makro-Code und die Suchergebnisse in einer Arbeitsmappe zusammengefasst sind. Diese Mappe darf sich auch in dem Such-Verzeichnis befinden.
Option Explicit
Option Compare Text
Const SuchPfad = "E:\Threads\137848\Test" 'Such-Ordnerpfad
Const SuchName = "*.xls*" 'Such-Dateien
Const SuchSpalte = "A" 'Such-Spalte
Const TitelZeile = "Dateiname,Produkt,Suchbegriff" 'Neue Mappe Überschrift in Zeile 1
Const StartZeile = 2 'Neue Mappe Einträge ab Zeile 2
Const Msg = "Der angegebene Ordner existiert nicht!"
Sub GetExternData()
Dim Wkb As Workbook, Wks As Worksheet, WksHome As Worksheet
Dim Fso As Object, File As Object, Found As Range, Search As String, NextLine As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler": Exit Sub
Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen...")
If Search = "" Then Exit Sub
Application.ScreenUpdating = False
Set WksHome = ThisWorkbook.Sheets(1)
WksHome.Cells.ClearContents
With WksHome.Range("A1:C1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Value = Split(TitelZeile, ",")
End With
NextLine = StartZeile
For Each File In Fso.GetFolder(SuchPfad).Files
If File.Name Like SuchName And Not File.Name Like ThisWorkbook.Name Then
Set Wkb = Workbooks.Open(File.Path)
For Each Wks In Wkb.Worksheets
If Not Wks.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart) Is Nothing Then
With WksHome.Rows(NextLine)
.Columns("A") = File.Name
.Columns("B") = Wks.Name
.Columns("C") = Search
NextLine = NextLine + 1
End With
End If
Next
Wkb.Close False
End If
Next
WksHome.Columns("A:C").AutoFit
Application.ScreenUpdating = True
End Sub
Gruß Dieter
[Edit] Codezeile 42 geändert [/Edit]
Hallo Dieter,
jetzt bekomme ich in der Zeile 42 " Set Wkb = GetObject(File.Path) " Fehlermeldung "Datei- oder Klassenname während Automatisierungs.... nicht gefunden ".
Die Tabelle ist geöffnet worden aber ohne Daten .
Ich entschuldige mich für meine Lästigkeit aber ich kann ohne Deine Hilfe dieses Problem nicht in Griff bekommen.
Danke.
Mfg. Max
P.S. Ich muß jetzt für 2 Stunden vom PC weg.
jetzt bekomme ich in der Zeile 42 " Set Wkb = GetObject(File.Path) " Fehlermeldung "Datei- oder Klassenname während Automatisierungs.... nicht gefunden ".
Die Tabelle ist geöffnet worden aber ohne Daten .
Ich entschuldige mich für meine Lästigkeit aber ich kann ohne Deine Hilfe dieses Problem nicht in Griff bekommen.
Danke.
Mfg. Max
P.S. Ich muß jetzt für 2 Stunden vom PC weg.
Hallo Max!
Kannst Du die Dateien in Excel normal öffnen?
Ersetze mal die Codezeile 42 durch:
Gruß Dieter
Kannst Du die Dateien in Excel normal öffnen?
Ersetze mal die Codezeile 42 durch:
Set Wkb = Workbooks.Open(File.Path)
Gruß Dieter
Hallo Max!
Also, die Ergebnisse sollten jetzt, sofern in Sheets Spalte A gefunden, in Deiner Makro-Datei Tabelle 1 zu sehen sein?
Die seperate Ergenis-Datei wurde im letzten Code entfernt.
Füge mal nach der Codezeile 46 diese Zeile mit ein
Dann sollte eine Meldung ausgegeben werden, wenn was gefunden wurde?
Gruß Dieter
Also, die Ergebnisse sollten jetzt, sofern in Sheets Spalte A gefunden, in Deiner Makro-Datei Tabelle 1 zu sehen sein?
Die seperate Ergenis-Datei wurde im letzten Code entfernt.
Füge mal nach der Codezeile 46 diese Zeile mit ein
MsgBox "Was gefunden!"
Gruß Dieter
Hallo Max!
Boah! Damit habe ich jetzt aber nicht gerechnet
Freut mich, dass es nun endlich doch noch funktioniert.
Gruß Dieter
Boah! Damit habe ich jetzt aber nicht gerechnet
Freut mich, dass es nun endlich doch noch funktioniert.
Gruß Dieter