Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Excel 2007 - Mehrere Excel-Dateien nach einem Wert duchsuchen und dazugeh. Daten abspeichern

Frage Microsoft Microsoft Office

Mitglied: user1234

user1234 (Level 1) - Jetzt verbinden

10.03.2010 um 09:21 Uhr, 15231 Aufrufe, 37 Kommentare

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ß
37 Antworten
Mitglied: 76109
10.03.2010 um 11:36 Uhr
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:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const SuchPfad = "E:\Test"              'Monats-Mappen Ordnerpfad 
05.
Const SuchSheet = "Tabelle1"            'Monats-Mappen Tabellenname 
06.
 
07.
Const NeueMappe = "E:\Test\Neu.xls"     'Neue Mappe Pfad 
08.
 
09.
Const StartZeile = 2                    'Neue Mappe Startzeile 
10.
 
11.
Const SuchSpalte = "U"                  'Monats-Mappen Spalte Suchen 
12.
Const SucheVon = "200801"               'Monats-Mappen Von Mappe 
13.
Const SucheBis = "200912"               'Monats-Mappen Bis Mappe 
14.
 
15.
Const Msg = "Der angegebene Ordner existiert nicht!" 
16.
 
17.
Sub GetExternData() 
18.
    Dim Wkb0 As Workbook, Wks0 As Worksheet, WksX As Worksheet, NextLine As Long 
19.
    Dim Fso As Object, Folder As Object, File As Object, c As Range, Search As String 
20.
     
21.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
22.
     
23.
    If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler":  Exit Sub 
24.
    
25.
    Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen") 
26.
     
27.
    If Search = "" Then Exit Sub 
28.
     
29.
    Workbooks.Add:  Set Wkb0 = ActiveWorkbook:  Set Wks0 = Wkb0.Sheets(1) 
30.
     
31.
    Set Folder = Fso.GetFolder(SuchPfad) 
32.
     
33.
    NextLine = StartZeile 
34.
     
35.
    Application.ScreenUpdating = False 
36.
     
37.
    For Each File In Folder.Files 
38.
        If LCase(Fso.GetExtensionName(File)) = "xls" And IsNumeric(Fso.GetBaseName(File)) = True Then 
39.
            If Fso.GetBaseName(File) >= SucheVon And Fso.GetBaseName(File) <= SucheBis Then 
40.
                Set WksX = GetObject(File.Path).Sheets(SuchSheet) 
41.
                Set c = WksX.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart) 
42.
                If Not c Is Nothing Then 
43.
                    WksX.Rows(c.Row).Copy Destination:=Wks0.Cells(NextLine, 1) 
44.
                    NextLine = NextLine + 1 
45.
                End If 
46.
                GetObject(File.Path).Close False 
47.
            End If 
48.
        End If 
49.
    Next 
50.
     
51.
    Wkb0.SaveAs NeueMappe:  Wkb0.Close 
52.
     
53.
    Application.ScreenUpdating = True 
54.
End Sub
Gruß Dieter

[edit] Codezeile 38 geändert. Test ob Dateiname numerisch ist hinzugefügt[/edit]
Bitte warten ..
Mitglied: user1234
10.03.2010 um 13:32 Uhr
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.
Bitte warten ..
Mitglied: 76109
10.03.2010 um 14:49 Uhr
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 Stress

Gruß Dieter
Bitte warten ..
Mitglied: user1234
10.03.2010 um 15:01 Uhr
Wie gesagt der Fehler erscheint nicht mehr. Danke!

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

Neuer Code mit Find-Next-Funktion:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const SuchPfad = "E:\Test"              'Monats-Mappen Ordnerpfad 
05.
Const SuchSheet = "Tabelle1"            'Monats-Mappen Tabellenname 
06.
 
07.
Const NeueMappe = "E:\Test\Neu.xls"     'Neue Mappe Pfad 
08.
 
09.
Const StartZeile = 2                    'Neue Mappe Startzeile 
10.
 
11.
Const SuchSpalte = "U"                  'Monats-Mappen Spalte Suchen 
12.
Const SucheVon = "200801"               'Monats-Mappen Von Mappe 
13.
Const SucheBis = "200912"               'Monats-Mappen Bis Mappe 
14.
 
15.
Const Msg = "Der angegebene Ordner existiert nicht!" 
16.
 
17.
Sub GetExternData() 
18.
    Dim Wkb0 As Workbook, Wks0 As Worksheet, WksX As Worksheet, NextLine As Long, FirstAddress As String 
19.
    Dim Fso As Object, Folder As Object, File As Object, c As Range, Search As String 
20.
     
21.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
22.
     
23.
    If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler":  Exit Sub 
24.
    
25.
    Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen") 
26.
     
27.
    If Search = "" Then Exit Sub 
28.
     
29.
    Workbooks.Add:  Set Wkb0 = ActiveWorkbook:  Set Wks0 = Wkb0.Sheets(1) 
30.
     
31.
    Set Folder = Fso.GetFolder(SuchPfad) 
32.
     
33.
    NextLine = StartZeile 
34.
     
35.
    Application.ScreenUpdating = False 
36.
     
37.
    For Each File In Folder.Files 
38.
        If LCase(Fso.GetExtensionName(File)) = "xls" And IsNumeric(Fso.GetBaseName(File)) = True Then 
39.
            If Fso.GetBaseName(File) >= SucheVon And Fso.GetBaseName(File) <= SucheBis Then 
40.
                Set WksX = GetObject(File.Path).Sheets(SuchSheet) 
41.
                Set c = WksX.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart) 
42.
                If Not c Is Nothing Then 
43.
                    FirstAddress = c.Address 
44.
                    Do: WksX.Rows(c.Row).Copy Destination:=Wks0.Cells(NextLine, 1) 
45.
                        NextLine = NextLine + 1 
46.
                        Set c = WksX.Columns(SuchSpalte).FindNext(c) 
47.
                    Loop While Not c Is Nothing And c.Address <> FirstAddress 
48.
                End If 
49.
                GetObject(File.Path).Close False 
50.
            End If 
51.
        End If 
52.
    Next 
53.
     
54.
    Wkb0.SaveAs NeueMappe:  Wkb0.Close 
55.
     
56.
    Application.ScreenUpdating = True 
57.
End Sub
Gruß Dieter

[edit] Codezeile 38 geändert. Test ob Dateiname numerisch ist hinzugefügt[/edit]
Bitte warten ..
Mitglied: user1234
10.03.2010 um 16:56 Uhr
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".
Bitte warten ..
Mitglied: 76109
10.03.2010 um 17:10 Uhr
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
Bitte warten ..
Mitglied: user1234
11.03.2010 um 09:36 Uhr
Viel Dank Dieter!

Du hast mir sehr viel Arbeit erspart!
Bitte warten ..
Mitglied: 76109
11.03.2010 um 09:58 Uhr
Hallo user1234!

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

Gruß Dieter
Bitte warten ..
Mitglied: maierse
01.03.2011 um 18:59 Uhr
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
Bitte warten ..
Mitglied: 76109
02.03.2011 um 01:12 Uhr
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
Bitte warten ..
Mitglied: maierse
02.03.2011 um 14:33 Uhr
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
Bitte warten ..
Mitglied: 76109
03.03.2011 um 00:39 Uhr
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
Bitte warten ..
Mitglied: maierse
03.03.2011 um 15:57 Uhr
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
Bitte warten ..
Mitglied: 76109
04.03.2011 um 11:13 Uhr
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:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const SuchPfad = "E:\Test"                      'Such-Ordnerpfad 
05.
Const SuchFiles = "Inhaltsverzeichnis*.xls"     'Such-Dateien 
06.
Const SuchSheet = "Tabelle1"                    'Such-Tabellenname 
07.
Const SuchSpalte = "U"                          'Such-Spalte 
08.
 
09.
Const NeueMappe = "E:\Test\Neu.xls"             'Neue Mappe Pfad 
10.
Const StartZeile = 2                            'Neue Mappe Startzeile 
11.
 
12.
Const Msg = "Der angegebene Ordner existiert nicht!" 
13.
 
14.
Sub GetExternData() 
15.
    Dim Wkb0 As Workbook, Wks0 As Worksheet, WksX As Worksheet, NextLine As Long, FirstAddress As String 
16.
    Dim Fso As Object, File As Object, c As Range, Search As String 
17.
     
18.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
19.
     
20.
    If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler":  Exit Sub 
21.
    
22.
    If Fso.FileExists(NeueMappe) = True Then Fso.DeleteFile NeueMappe 
23.
 
24.
    Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen") 
25.
     
26.
    If Search = "" Then Exit Sub 
27.
     
28.
    Workbooks.Add:  Set Wkb0 = ActiveWorkbook:  Set Wks0 = Wkb0.Sheets(1) 
29.
     
30.
    NextLine = StartZeile 
31.
     
32.
    Application.ScreenUpdating = False 
33.
     
34.
    For Each File In Fso.GetFolder(SuchPfad).Files 
35.
        If File.Name Like SuchFiles Then 
36.
            Set WksX = GetObject(File.Path).Sheets(SuchSheet) 
37.
            Set c = WksX.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart) 
38.
            If Not c Is Nothing Then 
39.
                FirstAddress = c.Address 
40.
                Do: WksX.Rows(c.Row).Copy Destination:=Wks0.Cells(NextLine, 1) 
41.
                    NextLine = NextLine + 1 
42.
                    Set c = WksX.Columns(SuchSpalte).FindNext(c) 
43.
                Loop While Not c Is Nothing And c.Address <> FirstAddress 
44.
            End If 
45.
            GetObject(File.Path).Close False 
46.
        End If 
47.
    Next 
48.
     
49.
    Wkb0.SaveAs NeueMappe:  Wkb0.Close 
50.
     
51.
    Application.ScreenUpdating = True 
52.
End Sub
Wobei die Neue Mappe zuvor gelöscht wird, falls diese schon existiert.

Gruß Dieter
Bitte warten ..
Mitglied: maierse
04.03.2011 um 12:48 Uhr
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
Bitte warten ..
Mitglied: maierse
15.03.2011 um 15:47 Uhr
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
Bitte warten ..
Mitglied: 76109
15.03.2011 um 18:01 Uhr
Hallo maierse!

Jepp, gern geschehen

Gruß Dieter
Bitte warten ..
Mitglied: reanimator
17.07.2011 um 20:09 Uhr
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.
Bitte warten ..
Mitglied: 76109
19.07.2011 um 13:33 Uhr
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):
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const SuchPfad = "X:\Test"                'Such-Ordnerpfad 
05.
Const SuchName = "*.xls*"                 'Such-Dateien (Wildcards erlaubt) 
06.
 
07.
Const SuchSpalte = "A"                    'Such-Spalte 
08.
 
09.
Const NeueMappe = "X:\Test\Ergebnis"      'Neue Mappe Pfad (ohne .xls/.xlsx) 
10.
 
11.
Const TitelZeile = "Dateiname,Produkt,Suchbegriff"      'Neue Mappe Überschrift in Zeile 1 
12.
Const StartZeile = 2                                    'Neue Mappe Einträge ab Zeile 2 
13.
 
14.
Const Msg = "Der angegebene Ordner existiert nicht!" 
15.
 
16.
Sub GetExternData() 
17.
    Dim Wkb0 As Workbook, WkbX As Workbook, Wks0 As Worksheet, Wks As Worksheet 
18.
    Dim Fso As Object, File As Object, Found As Range, Search As String, NextLine As Long    
19.
  
20.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
21.
     
22.
    If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler":  Exit Sub 
23.
    
24.
    Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen") 
25.
     
26.
    If Search = "" Then Exit Sub 
27.
     
28.
    Application.ScreenUpdating = False 
29.
     
30.
    Workbooks.Add:  Set Wkb0 = ActiveWorkbook:  Set Wks0 = Wkb0.Sheets(1) 
31.
     
32.
    With Wks0.Range("A1:C1") 
33.
        .Font.Bold = True 
34.
        .HorizontalAlignment = xlCenter 
35.
        .Value = Split(TitelZeile, ",") 
36.
    End With 
37.
     
38.
    NextLine = StartZeile 
39.
     
40.
    For Each File In Fso.GetFolder(SuchPfad).Files 
41.
        If File.Name Like SuchName And Not File.Path Like NeueMappe & ".xls*" Then 
42.
            Set WkbX = GetObject(File.Path) 
43.
             
44.
            For Each Wks In WkbX.Worksheets 
45.
                If Not Wks.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart) Is Nothing Then 
46.
                    With Wks0.Rows(NextLine) 
47.
                        .Columns("A") = File.Name 
48.
                        .Columns("B") = Wks.Name 
49.
                        .Columns("C") = Search 
50.
                         NextLine = NextLine + 1 
51.
                    End With 
52.
                End If 
53.
            Next 
54.
             
55.
            WkbX.Close False 
56.
        End If 
57.
    Next 
58.
     
59.
    Wks0.Columns("A:C").AutoFit 
60.
     
61.
    With Wkb0 
62.
        .Application.DisplayAlerts = False 
63.
        .SaveAs NeueMappe, xlNormal 
64.
        .Application.DisplayAlerts = True 
65.
        .Close False 
66.
    End With 
67.
     
68.
    Application.ScreenUpdating = True 
69.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: reanimator
19.07.2011 um 14:21 Uhr
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.
Bitte warten ..
Mitglied: 76109
19.07.2011 um 14:33 Uhr
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
Bitte warten ..
Mitglied: reanimator
19.07.2011 um 15:01 Uhr
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
Bitte warten ..
Mitglied: 76109
19.07.2011 um 16:20 Uhr
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
Bitte warten ..
Mitglied: reanimator
19.07.2011 um 17:28 Uhr
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
Bitte warten ..
Mitglied: 76109
19.07.2011 um 17:45 Uhr
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
Bitte warten ..
Mitglied: reanimator
19.07.2011 um 19:30 Uhr
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
Bitte warten ..
Mitglied: 76109
19.07.2011 um 20:02 Uhr
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
Bitte warten ..
Mitglied: 76109
20.07.2011 um 08:36 Uhr
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.

01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const SuchPfad = "E:\Threads\137848\Test"               'Such-Ordnerpfad 
05.
Const SuchName = "*.xls*"                               'Such-Dateien 
06.
 
07.
Const SuchSpalte = "A"                                  'Such-Spalte 
08.
 
09.
Const TitelZeile = "Dateiname,Produkt,Suchbegriff"      'Neue Mappe Überschrift in Zeile 1 
10.
Const StartZeile = 2                                    'Neue Mappe Einträge ab Zeile 2 
11.
 
12.
Const Msg = "Der angegebene Ordner existiert nicht!" 
13.
 
14.
Sub GetExternData() 
15.
    Dim Wkb As Workbook, Wks As Worksheet, WksHome As Worksheet 
16.
    Dim Fso As Object, File As Object, Found As Range, Search As String, NextLine As Long 
17.
     
18.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
19.
     
20.
    If Fso.FolderExists(SuchPfad) = False Then MsgBox Msg, vbExclamation, "Fehler":  Exit Sub 
21.
    
22.
    Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen...") 
23.
     
24.
    If Search = "" Then Exit Sub 
25.
     
26.
    Application.ScreenUpdating = False 
27.
     
28.
    Set WksHome = ThisWorkbook.Sheets(1) 
29.
     
30.
    WksHome.Cells.ClearContents 
31.
     
32.
    With WksHome.Range("A1:C1") 
33.
        .Font.Bold = True 
34.
        .HorizontalAlignment = xlCenter 
35.
        .Value = Split(TitelZeile, ",") 
36.
    End With 
37.
     
38.
    NextLine = StartZeile 
39.
     
40.
    For Each File In Fso.GetFolder(SuchPfad).Files 
41.
        If File.Name Like SuchName And Not File.Name Like ThisWorkbook.Name Then 
42.
            Set Wkb = Workbooks.Open(File.Path) 
43.
             
44.
            For Each Wks In Wkb.Worksheets 
45.
                If Not Wks.Columns(SuchSpalte).Find(Search, LookIn:=xlValues, LookAt:=xlPart) Is Nothing Then 
46.
                    With WksHome.Rows(NextLine) 
47.
                        .Columns("A") = File.Name 
48.
                        .Columns("B") = Wks.Name 
49.
                        .Columns("C") = Search 
50.
                         NextLine = NextLine + 1 
51.
                    End With 
52.
                End If 
53.
            Next 
54.
             
55.
            Wkb.Close False 
56.
        End If 
57.
    Next 
58.
     
59.
    WksHome.Columns("A:C").AutoFit 
60.
     
61.
    Application.ScreenUpdating = True 
62.
End Sub
Der Inhalt des Tabellenblatts wird vor jeder neuen Suche gelöscht.

Gruß Dieter

[Edit] Codezeile 42 geändert [/Edit]
Bitte warten ..
Mitglied: reanimator
20.07.2011 um 08:47 Uhr
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
Bitte warten ..
Mitglied: reanimator
20.07.2011 um 10:45 Uhr
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.
Bitte warten ..
Mitglied: 76109
20.07.2011 um 11:56 Uhr
Hallo Max!

Kannst Du die Dateien in Excel normal öffnen?

Ersetze mal die Codezeile 42 durch:
01.
            Set Wkb = Workbooks.Open(File.Path)
Gruß Dieter
Bitte warten ..
Mitglied: reanimator
20.07.2011 um 14:18 Uhr
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
Bitte warten ..
Mitglied: 76109
20.07.2011 um 14:39 Uhr
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
01.
MsgBox "Was gefunden!"
Dann sollte eine Meldung ausgegeben werden, wenn was gefunden wurde?

Gruß Dieter
Bitte warten ..
Mitglied: reanimator
20.07.2011 um 15:52 Uhr
Hallo Dieter,

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

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

Herzlichen Dank für Deine Hilfe!
Max.
Bitte warten ..
Mitglied: 76109
20.07.2011 um 16:11 Uhr
Hallo Max!

Boah! Damit habe ich jetzt aber nicht gerechnet

Freut mich, dass es nun endlich doch noch funktioniert.

Gruß Dieter
Bitte warten ..
Mitglied: reanimator
20.07.2011 um 17:19 Uhr
Hallo Dieter,

eine kurze Frage noch: bist Du zufällig auch so FIT in Access im Makrobereich?
Mfg.Max
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (20)

Frage von Xaero1982 zum Thema Microsoft ...

Outlook & Mail
gelöst Outlook 2010 findet ost datei nicht (19)

Frage von Floh21 zum Thema Outlook & Mail ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (18)

Frage von Unwichtig zum Thema Netzwerkmanagement ...

Festplatten, SSD, Raid
M.2 SSD wird nicht erkannt (14)

Frage von uridium69 zum Thema Festplatten, SSD, Raid ...