user1234
Goto Top

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ß

Content-ID: 137848

Url: https://administrator.de/contentid/137848

Ausgedruckt am: 08.11.2024 um 21:11 Uhr

76109
76109 10.03.2010 um 11:36:24 Uhr
Goto Top
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:
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]
user1234
user1234 10.03.2010 um 13:32:32 Uhr
Goto Top
Wow. Vielen Dank.

Allerdings klappt es nicht ganz rund.

Ich habe den Quellcode als Makro hinzugefügt und die ensprechenden Pfade etc. geändert.

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.

Beim erneuten ausführen kam keine Fehlermeldung und er zeigte die Daten bis 200903 an. Ich habe jeweils denselben Suchbegriff verwendet.


Ich habe mich im Anfangspost falsch formuliert. "Hans" kann natürlich öfter als einmal in einem Monat vorkommen.
Dies ist aber immer variabel. Wie kann ich den Quellcode erweitern, dass er mir nicht nur einen Datensatz pro Monat anzeigt?


Vielen, vielen Dank Dieter, für deine Antwort!

Gruß

Edit:
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.
76109
76109 10.03.2010 um 14:49:19 Uhr
Goto Top
Hallo user1234!

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.
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 Stressface-wink

Gruß Dieter
user1234
user1234 10.03.2010 um 15:01:47 Uhr
Goto Top
Wie gesagt der Fehler erscheint nicht mehr. Danke!

Vllt. kann ja auch ein anderer User wegen den Zeilen helfen ;)
76109
76109 10.03.2010 um 15:36:16 Uhr
Goto Top
Hallo user1234!

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]
user1234
user1234 10.03.2010 um 16:56:53 Uhr
Goto Top
Du bist grandios!

Kleine Frage habe ich dennoch:
Wie erreiche ich, dass er nicht beim Suchwort "Hans" auch "ahansb" findet.

Ich weiß, dass es nur xlPart und xlWhole gibt.
Kann man die Suche trotzdem irgendwie verfeinern, dass er "ahansb" nicht findet, wohl aber "Hans Müller", "Hans-Müller" oder "Müller-Hans".
76109
76109 10.03.2010 um 17:10:18 Uhr
Goto Top
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 liefernface-wink

Gruß Dieter
user1234
user1234 11.03.2010 um 09:36:09 Uhr
Goto Top
Viel Dank Dieter!

Du hast mir sehr viel Arbeit erspart!
76109
76109 11.03.2010 um 09:58:04 Uhr
Goto Top
Hallo user1234!

Zitat von @user1234:
Viel Dank Dieter!
Yepp, gern geschehenface-wink
Du hast mir sehr viel Arbeit erspart!
Das kann ich mir sehr gut vorstellen!

Gruß Dieter
maierse
maierse 01.03.2011 um 18:59:07 Uhr
Goto Top
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
76109
76109 02.03.2011 um 01:12:51 Uhr
Goto Top
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
maierse
maierse 02.03.2011 um 14:33:39 Uhr
Goto Top
Hallo Dieter!

Es sind 22 Dateien. Gemeinsam haben Sie alle den Namen "Inhaltsverzeichnis", danach kommt noch die Nummer und ein Name "Atlas" oder "Cooper".

Grüße von maierse
76109
76109 03.03.2011 um 00:39:40 Uhr
Goto Top
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
maierse
maierse 03.03.2011 um 15:57:05 Uhr
Goto Top
Hallo Dieter!

Es sind 22 Dateien in einem Ordner!

Datei 1 : Inhaltsverzeichnis 01 Atlas
Datei 2 : Inhaltsverzeichnis 02 Atlas
Datei 3 : Inhaltsverzeichnis 03 Atlas
Datei 4 : Inhaltsverzeichnis 04 Cooper

usw.

Ich hoffe es Ist jetzt verständlich?

Grüße von maierse
76109
76109 04.03.2011 um 11:13:14 Uhr
Goto Top
Hallo maierse!

Scheinbar reden wir aneinander vorbeiface-wink 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
Wobei die Neue Mappe zuvor gelöscht wird, falls diese schon existiert.

Gruß Dieter
maierse
maierse 04.03.2011 um 12:48:23 Uhr
Goto Top
Hallo Dieter!
Vielen Dank für deine Antwort. Ich bin jetzt aber 5 Tage im Urlaub, und kann erst
dann im Geschäft weitermachen. Ich werde Dir dann schreiben ob es geklappt hat.

Vielen Dank für deine Bemühungen.

Grüße von maierse
maierse
maierse 15.03.2011 um 15:47:48 Uhr
Goto Top
Hallo Dieter!
Endlich bin ich dazu gekommen - und es funktioniert!
Ich bin total happy, nochmals vielen, vielen Dank dafür.

Viele Grüße von maierse
76109
76109 15.03.2011 um 18:01:56 Uhr
Goto Top
Hallo maierse!

Jepp, gern geschehenface-wink

Gruß Dieter
reanimator
reanimator 17.07.2011 um 20:09:31 Uhr
Goto Top
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.
76109
76109 19.07.2011 um 13:33:13 Uhr
Goto Top
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):
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
reanimator
reanimator 19.07.2011 um 14:21:59 Uhr
Goto Top
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.
76109
76109 19.07.2011 um 14:33:17 Uhr
Goto Top
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
reanimator
reanimator 19.07.2011 um 15:01:21 Uhr
Goto Top
Hallo Dieter,

ich habe jetzt die Datei mit Makro in anderen Verzeichnis gespeichert. Nach dem Ausführen ( man sieht das etwas läuft ) bekomme ich in der neuen Ergebnis -Tabell keine Daten nur leere Mappe sogar ohne Zellen ohne Spalten. Was mache ich falsch??
Vielen Dank.
Mfg. Max
76109
76109 19.07.2011 um 16:20:57 Uhr
Goto Top
Hallo Max!

Verstehe ich nicht, bei mir läuft's einwandfreiface-sad

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
reanimator
reanimator 19.07.2011 um 17:28:22 Uhr
Goto Top
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
76109
76109 19.07.2011 um 17:45:47 Uhr
Goto Top
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:
Wks0.Visible = True

Gruß Dieter
reanimator
reanimator 19.07.2011 um 19:30:26 Uhr
Goto Top
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
76109
76109 19.07.2011 um 20:02:51 Uhr
Goto Top
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:
' .Close False
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
76109
76109 20.07.2011 um 08:36:39 Uhr
Goto Top
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.

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
Der Inhalt des Tabellenblatts wird vor jeder neuen Suche gelöscht.

Gruß Dieter

[Edit] Codezeile 42 geändert [/Edit]
reanimator
reanimator 20.07.2011 um 08:47:21 Uhr
Goto Top
Hallo Dieter,

dieser Versuch hat auch leider nichts gebracht. Ergebnistabelle bleibt nicht geöffnet, sie muß ich manuell extra aufmachen. Die Ergebnistabelle hat kein Makro in sich und ich habe zwei separate Arbeitsmappen.

Mfg. Max
reanimator
reanimator 20.07.2011 um 10:45:32 Uhr
Goto Top
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.
76109
76109 20.07.2011 um 11:56:33 Uhr
Goto Top
Hallo Max!

Kannst Du die Dateien in Excel normal öffnen?

Ersetze mal die Codezeile 42 durch:
            Set Wkb = Workbooks.Open(File.Path)

Gruß Dieter
reanimator
reanimator 20.07.2011 um 14:18:05 Uhr
Goto Top
Hallo Dieter,


ich habe jetzt die Zeile42 abgeändert. Jetzt läuft es durch. Man siht unten das die Dateien " geöffnet-geschloßen " sind.
Keine Fehlermeldung erscheint. Aber ich finde immer noch keine Tabelle mit Ergebnis. Niergendwo!
Danke.
Mfg.Max
76109
76109 20.07.2011 um 14:39:47 Uhr
Goto Top
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
MsgBox "Was gefunden!"  
Dann sollte eine Meldung ausgegeben werden, wenn was gefunden wurde?

Gruß Dieter
reanimator
reanimator 20.07.2011 um 15:52:43 Uhr
Goto Top
Hallo Dieter,

es läuft und ohne Fehler!!!!!!!!

Du bist einfach S U P E R!!!!!!!!!!!!!!!!!!!!

Herzlichen Dank für Deine Hilfe!
Max.
76109
76109 20.07.2011 um 16:11:26 Uhr
Goto Top
Hallo Max!

Boah! Damit habe ich jetzt aber nicht gerechnetface-wink

Freut mich, dass es nun endlich doch noch funktioniert.

Gruß Dieter
reanimator
reanimator 20.07.2011 um 17:19:30 Uhr
Goto Top
Hallo Dieter,

eine kurze Frage noch: bist Du zufällig auch so FIT in Access im Makrobereich?
Mfg.Max