Top-Themen

Aktuelle Themen (A bis Z)

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

Mitglied: user1234

user1234 (Level 1) - Jetzt verbinden

10.03.2010 um 09:21 Uhr, 17541 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 ..
Ähnliche Inhalte
VB for Applications
Excel Wert Abfrage
gelöst Frage von Florian86VB for Applications3 Kommentare

Hallo, ich möchte über ein Makro eine Abfrage machen leider komme ich nicht zum gewünschten Ergebnis. Ich habe 2 ...

Microsoft Office
Excel VBA Wert hochzählen
gelöst Frage von Florian86Microsoft Office1 Kommentar

Hallo, ich habe im VBA Code folgendes stehen Range("E10") = Range("E10") + 1 Jetzt ist der Wert bei schon ...

Microsoft Office
Excel nächstligenden Wert ausgeben
gelöst Frage von Florian86Microsoft Office5 Kommentare

Hallo, ich habe folgende Tabelle Spalte A Spalte B Spalte C Spalte D Spalte E Spalte F Wert1 Bemerkung ...

VB for Applications
Excel 2007 - Macro
Frage von EverestVB for Applications4 Kommentare

Hallo Excel-Spezialisten, ich habe eine Frage. Gibt es eine Möglichkeit, die Einstellung des Makros NUR für eine bestimmte Datei, ...

Neue Wissensbeiträge
Windows 7
Updategängelung auf Windows 10, die zweite
Information von Penny.Cilin vor 3 TagenWindows 71 Kommentar

Hallo, da Windows 7 im kommenden Jahr nicht mehr supportet wird, werden Nutzer von Window 7 home premium wieder ...

Internet
EU-Urheberrechtsreform: Zusammenfassung
Information von Frank vor 5 TagenInternet1 Kommentar

Auf golem.de gibt es eine Analyse von Friedhelm Greis, der das Thema EU-Urheberrechtsreform gut und strukturiert zusammenfasst. Zwar haben ...

Microsoft Office

Office365 Schwachstellen bei Sicherheit und Datenschutz

Information von Penny.Cilin vor 6 TagenMicrosoft Office9 Kommentare

Auf Heise+ gibt es einen Artikel bzgl. Office365 Schwachstellen. Das ist noch ein Grund mehr seine Daten nicht in ...

Sicherheit
Schwachstellen in VPN Clients
Tipp von transocean vor 8 TagenSicherheit2 Kommentare

Moin, es gibt Sicherheitslücken bei VPN Clients namhafter Hersteller, wie man hier lesen kann. Gruß Uwe

Heiß diskutierte Inhalte
Utilities
Teamviewer 9.x "out of date" ??
gelöst Frage von keine-ahnungUtilities13 Kommentare

Moin at all, mein topaktueller teamviewer (alles 9.x - releases) verweigert seit heute die Arbeit und bemeckert: "the remote ...

Peripheriegeräte
PS2 Y-Kabel für Maus+Tastatur an PS2 Combo-Anschluss ASUS Prime X370-A
gelöst Frage von Windows10GegnerPeripheriegeräte12 Kommentare

Hallo, ich bin am Überlegen das o.g. Motherboard anzuschaffen. Da ich aber noch PS/2 für Maus+Tastatur benötige (bei optischen ...

Windows 10
Netzlaufwerk verschwindet (aber nur bestimmter Laufwerksbuchstabe)
gelöst Frage von survial555Windows 1010 Kommentare

Hallo, ich habe ein ganz seltsames Problem. Systemumgebung: Server 2012 R2 als DC und Windows 10 Pro als Clients ...

Voice over IP
Anbindung Telekom Cloud PBX mit Sophos SG330
gelöst Frage von macomarVoice over IP7 Kommentare

Hallo an alle, wir beabsichtigen mit unserer alten Siemens Telefonanlage auf Telekom Cloud PBX umzusteigen. Da wir eine Verwaltung ...