Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1104to1108
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dateiordner mit 350 Excelsheets auslesen

Dateiordner mit 350 Excelsheets auslesen
Gerhard
Guten Morgen da draussen
Wurde hier mit einem Prob beauftragt und weiss absolut nicht wie ich das lösen kann
Habe einen Ordner Namens Werkzeuglisten. In diesem sind ca. 350 Excellisten.
Ich muss nun in diesen 350 Excellisten suchen wo sich das Werkzeug mit der Bezeichnung "WZK-91" befindet. Klar könnt ich das alles von Hand suchen, aber das muss doch auch über n Makro funzen, oder?
So in etwa:
Öffne Pfad C:\WERKZEUGLISTEN
Öffne erste Datei (haben alle versch. Dateinamen!!!) und schaue in Spalte C nach WZK-91
Wenn gefunden, übertrage Dateinamen in in neues Sheet namens "ÜBERSICHT"
Schliesse Datei und öffne nächste
usw.
Kann mir dabei jemand helfen oder hat vllt. schon ne Lösung?
Wäre super, danke für die Hilfe schon mal
Greetz Gerhard
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 08:22:13
Tino
Hallo,
in den Dateien in WERKZEUGLISTEN, wo befindet sich diese Liste, auf welcher Tabelle?
Gruß Tino
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 08:42:18
Gerhard
Hallo Tino
Ich hoff ich verstehe dich richtig:
C:\WERKZEUGLISTEN\ ist der Pfad
in diesem Ordner liegen 350 Excel Sheets mit unterschiedlichen Dateinamen.
In diesen Excelsheets, steht in Tabellenblatt "WZK" in Spalte C verschiedene WZK Nummern. und da muss ich suchen nach "WZK-91".
Wenn gefunden soll der Dateinamen in dem WZK-91 gefunden wurde in einer neuen Exceldatei der Dateinamen eingetragen werden.
Das gesuchte WZK-91 ist vermutlich in 15-20 Werkzeuglisten enthalten... und diese Dateinamen brauche ich alle...
Greetz Gerhard
Anzeige
hier meine Version.
24.09.2009 08:57:55
Tino
Hallo,
kannst ja mal testen.
Sub LeseDaten()
Dim strFile As String, strPfad As String, strWerkzeug As String
Dim oWB As Workbook, rZelle As Range
Dim meAr(), A As Long
Dim NeuTab As Worksheet
Dim iCalc As Integer

strWerkzeug = "WZK-91" 'Suchwerkzeug 

strPfad = "C:\WERKZEUGLISTEN\" 'Pfad am ende auf \ achten 

strFile = Dir(strPfad & "*.xls")

If strFile <> "" Then
        With Application
          iCalc = .Calculation
         .ScreenUpdating = False
         .EnableEvents = False
         .Calculation = xlCalculationManual
         .DisplayAlerts = False
         
            Do While strFile <> ""
             
             On Error Resume Next
                Set oWB = Workbooks.Open(strPfad & strFile, True, True)
                Set rZelle = oWB.Sheets("WZK").Columns(3).Find(What:=strWerkzeug, LookIn:=xlValues, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
                
                   If Not rZelle Is Nothing And Err.Number = 0 Then
                    A = A + 1
                    Redim Preserve meAr(1 To 2, 1 To A)
                    meAr(1, A) = strFile
                    meAr(2, A) = rZelle.Address(False, False)
                   End If
              
                   oWB.Close False
                   strFile = Dir()
             On Error GoTo 0: Err.Clear
            
            Loop
        
            If A > 0 Then
             On Error Resume Next
              Set NeuTab = Sheets("ÜBERSICHT")
             On Error GoTo 0
              
              If NeuTab Is Nothing Then
                Set NeuTab = Worksheets.Add 'neue Tabelle erstellen 
                NeuTab.Name = "ÜBERSICHT" 'name vergeben 
              Else
                NeuTab.Range("A:B").Value = ""
              End If
                
                NeuTab.Range("A1") = "Dateiname"
                NeuTab.Range("B1") = "In Zelle"
                NeuTab.Range("A1:B1").Font.Bold = True
                NeuTab.Range("A2").Resize(Ubound(meAr, 2), Ubound(meAr)) = .Transpose(meAr)
             
            End If
         
         .DisplayAlerts = True
         .ScreenUpdating = True
         .EnableEvents = True
         .Calculation = iCalc
        End With
End If
End Sub
Gruß Tino
Anzeige
AW: hier meine Version.
24.09.2009 09:16:59
Gerhard
Super danke TIno
Eine Frage bevor ich das Starte...
Ich öffne ein neues Excelsheet und trage hier das Macro ein. Drücke Start... Fügt es dann hier in der neuen Datei die Dateinamen ein?
So sollte es eig. sein, sorry wenn ich mich umständlich ausgedrückt haben sollte, auf keinen Fall darf das Sheet in die Werkzeuglisten eingefügt werden!!!
Greetz Gerhard
sollte eigentlich funzen.
24.09.2009 09:42:34
Tino
Hallo,
ist die Tabelle ÜBERSICHT vorhanden wird dies dort eingetragen,
ist diese nicht vorhanden wird sie erstellt.
In Spalte A sollte der Dateiname stehen und in B die Zelladresse wo gefunden.
Habe es allerdings nur an zwei Dateien getestet.
Bei 350 Dateien, wirst Du etwas Geduld mitbringen müssen.
Gruß Tino
Anzeige
Anmerkungen Update Links und Zellen leeren
24.09.2009 13:28:10
fcs
Hallo Gerhard,
2 Tipps noch:
1. Dein Problem mit dem Update der Links
Diesen optionalen Parameter kannst du beim Öffnen der Datei mitgeben als Parameter. Tino hat in seiner Prozedur die Parameterbezwichnungen weggelassen und die Werte "nur" in der korrekten Reihenfolge durch Komma getrennt.
Version mit Parameter:
    Set oWB = Application.Workbooks.Open(Filename:=strPfad & strFile, _
UpdateLinks:=True, ReadOnly:=True)

2. Zellbereiche leeren
Hierfür besser nicht
                NeuTab.Range("A:B").Value = ""
sondern
NeuTab.Range("A:B").ClearContents
verwenden. Eine ganze Spalte voller Leerstrings schreiben ist nicht so prickelnd und vergrößert ggf. unnötig die Dateigröße.
Gruß
Franz
Anzeige
Wiederspruch.
24.09.2009 13:39:07
Tino
Hallo,
zu erstens.
in meinen Versionen ist die Anordnung immer gleich ob Verion XP, 2003 oder 2007.
Also kann braucht man die Parameter nicht explizit angeben, kann man muss nicht.
zu zweitens.
NeuTab.Range("A:B").Value = "" ist schneller als
NeuTab.Range("A:B").ClearContents
Leerzellen sind danach immer noch leer also Empty
Gruß Tino
AW: Wiederspruch - weitestgehend akzeptiert
24.09.2009 17:10:53
fcs
Hallo Tino,
ob mit oder ohne Parameterbezeichnung ist wohl auch Sache des Geschmacks bzw. der Gewohnheiten. Ich hab mir angewöhnt, die Parameter-Bezeichnungen bei vielen Methoden und Eigenschaften mit anzugeben. Ausnahmen: Cells und Range
Prozeduren lesen sich dann meist einfacher, auch wenn der Prozedur-Text etwas länger wird.
Glücklicherweise hat es Microsoft ja geschafft bei Ergänzungen von Parametern diese nur anzufügen. Davon speziell betroffen war der Übergang Excel 97 auf 2000 und neuere. Weshalb 97 mit neueren VBA-Versionen auch wegen Parameter-Erweiterungen ins stolpern kommt, nicht nur wegen neuer Methoden und Eigenschaften..
Leerstrings:
Einfügen per VBA hinterläßt in der Tat keine Spuren - wie ich eben nach über 14 Jahren Excel-VBA-Nutzung festgestellt hab.
Entweder war dem früher nicht so oder ich bin unter dem Eindruck, dass Formeln mit Ergebnis "" nach "Kopieren" und "Einfügen nur Werte" eben keine leeren Zellen hinterlassen, dazu übergegangen grundsätzlich "ClearContents" zum Aufräumen zu verwenden. Zumindest Anweisungen wie
Cells(Rows.Count, 2).End(xlUp).Row
identifizieren solche Zellen als nicht leer.
Gruß
Franz
Anzeige
aus dem Nähkästchen...
24.09.2009 17:47:21
Tino
Hallo Franz,
ich habe erst seit ca. 5 oder 6 Jahren das VBA für mich entdeckt und lerne fast täglich neue Sachen
mansche vergesse ich auch wieder (Platzmangel ;-)), aber das macht es ja so interessant.
War mal eine Sache hier im Forum, ich hatte unter xl2007 ein Programm erstellt,
lief auch recht flott bei mir (Aufbau war anders wie hier).
Der Fragende allerding klagte es würde so schrecklich lange dauern,
daraufhin hatte ich die xl2003 Kiste angeschissen und tatsächlich es war nachvollziehbar.
Bei versuchen ist dann dieses Ergebnis raus gekommen,
dass Ergebnis ist gleich (Format bleibt erhalten) und auch noch schneller ist.
Seither verwende ich eigentlich nur diese Variante, weil das
Naja genug aus dem Nähkästchen geblauter, Gerhard kann sich ja nun was nach seinen Geschmack raussuchen.
Gruß Tino
Anzeige
Anmerkung zu ClearContents u. Value,
24.09.2009 14:11:37
Tino
Hallo,
zu zweitens ist nur relevant bis Version xl2003.
Bei zwei ganzen Spalten, macht dies bei mir ein Unterschied von 3 Sekunden aus.
Ab xl2007 sind beide Versionen gleich schnell.
Gruß Tino
AW: Anmerkung zu ClearContents u. Value,
29.09.2009 10:37:04
Gerhard
Spät aber dennoch ne Antwort...
Es öffnet Dateien, esch liesst sie, ohne Aktualisierung, nur eintragen in ne Excelliste, wenn er was gefunden hat... das tut es nicht...
Habe n neues WZK ausprobiert wo ich mir sicher bin das es in jeder zweiten Liste drin ist... neee leider ned...
Also nochmals zum Verständniss
Ich öffne eine neue Exceldatei, füge das Macro von TIno ein, drücke Play...
öffnet, schliesst die gewünschten Dateien, und mehr aber ned...
:(
Greetz Gerhard
Anzeige
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 08:41:45
Harald
Hallo Gerhard,
das wäre ein ausbaufähiger Ansatz:
Sub test()
Dim FSObjekt As Object
Dim FSFolder As Object
Dim FsFileList As Object
Dim FSFile As Object
Const Suchfolder = "D:\temp" ' Anpassen!
Dim ThisWorkbook As Workbook
Dim lastrow As Long
Dim Zeile As Long
Dim Suchstring As String
Dim c As Variant
Set ThisWorkbook = ActiveWorkbook
Set FSObjekt = CreateObject("Scripting.FileSystemObject")
Set FSFolder = FSObjekt.GetFolder(Suchfolder)
Set FsFileList = FSFolder.Files
Application.ScreenUpdating = False
lastrow = ActiveSheet.Range("a65536").End(xlUp).Row
For Zeile = 1 To lastrow
Suchstring = ThisWorkbook.Sheets("Sheet1").Cells(Zeile, 1) ' ggfls. Tabellenblattnamen  _
anpasssen
For Each FSFile In FsFileList
If UCase(FSObjekt.GetExtensionName(FSFile)) = "XLS" Then ' Nur Excel Files
Workbooks.Open (FSFile)
With Worksheets(1).Range("c1:c65536")
Set c = .Find(Suchstring, LookIn:=xlValues)
If Not c Is Nothing Then
ThisWorkbook.Sheets("Sheet1").Cells(Zeile, 2) = FSFile.Name ' ggfls.  _
Tabellenblattnamen anpasssen
End If
End With
ActiveWorkbook.Close
End If
Next FSFile
Next Zeile
End Sub
In Spalte A der Excel-Tabelle, in der sich dieses Makro befindet, stehen untereinander die zu findenden Namen. Die zu durchsuchenden Dateien stehen in d:\temp (kann im Quelltext geändert werden).
Wichtig: Die Datei mit den Namen darf nicht im Suchverzeichnis stehen, sonst versucht das Makro, diese auch zu öfffnen und stolpert.
Gruß
Haarald
Anzeige
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 08:50:26
Gerhard
Moin Harald...
eine Frage, die Exceltabellen wenn geöffnet werden, wollen aktualiesert werden.
Kann dieses "automatisiert" werden? Also Aktualisieren NEIN z. B.?
Danke
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 08:59:22
David
Hallo Gerhard,
Application.DisplayAlerts = False (True)
Gruß
David
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 09:05:01
Gerhard
Danke David nur...
wo muss ich das bei Haralds Vorschlag einfügen?
thx Gerhard
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 09:07:22
Harald
Z.B. hier hinter:
Application.ScreenUpdating = False
Application.DisplayAlerts=False
und ganz am Ende (habe ich vergessen
Application.ScreenUpdating = True
Application.DisplayAlerts=True
Gruß
Harald
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 09:18:16
Gerhard
leider nein...
will immer noch die Verknüpfungen aktualisieren...
Gerhard
Anzeige
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 09:19:33
Harald
Hallo Gerhard,
guck mal in den Code von TIMO. Dort wird auch noch die Berechnung auf manuell umgestellt, vielleicht hilft das?
Gruß
Harald
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 09:23:55
David
Hallo Gerhard,
Menü "Bearbeiten - Verknüpfungen"
Schaltfläche "Eingabeaufforderung beim Start"
2. oder 3. Option wählen, je nach Gusto.
Gruß
David
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 09:24:46
Gerhard
neee war auch ned...
Das gibts doch ned... :)
Gruß Gerhard
Sorry, bin ratlos
24.09.2009 09:26:05
Harald
AW: Dateiordner mit 350 Excelsheets auslesen
24.09.2009 09:46:43
JogyB
Hi.
Hier noch meine Version:
Sub readWkz(Optional suchStr)
Dim quellWbk As Workbook
Dim myFile As String
Dim foundFiles() As String
Const myPath = "c:\Werkzeuglisten\"
Const suchDatei = "*.xls"
Const searchSheet = "WKZ"
Const searchCol = 3
' Suchstring kann übergeben werden, wenn das nicht passiert ist dann wird
' dieser abgefragt
If IsMissing(suchStr) Then
suchStr = Application.InputBox("Suchbegriff eingeben", "Suchbegriff")
' Abbrechen betätigt oder nichts eingeben
If suchStr = "" Then Exit Sub
End If
Application.ScreenUpdating = False
' Zielarray vordimensionieren
ReDim foundFiles(0 To 0)
myFile = Dir(myPath & suchDatei)
While myFile  ""
With Workbooks.Open(myPath & myFile, False, True)
' Fehlerbehandlung aus, falls Sheet nicht existiert
On Error Resume Next
If Not .Sheets("WKZ").Columns(searchCol).Find(suchStr, , xlValues) Is Nothing Then
' An diese Stelle gelangt es auch bei einem Fehler, daher noch Fehlerabfrage
If Err.Number = 0 Then
' Array mit den Dateinamen dimensionieren
If UBound(foundFiles) = 0 Then
ReDim foundFiles(1 To 1)
Else
ReDim Preserve foundFiles(1 To UBound(foundFiles) + 1)
End If
foundFiles(UBound(foundFiles)) = myFile
End If
End If
On Error GoTo 0
.Close False
End With
myFile = Dir
Wend
' Wenn was gefunden wurde
If UBound(foundFiles) > 0 Then
Workbooks.Add.Sheets(1).Cells(1, 1).Resize(UBound(foundFiles)).Value _
= Application.Transpose(foundFiles)
Else
MsgBox ("Nichts gefunden")
End If
Application.ScreenUpdating = True
End Sub

Die Arbeitsmappen werden ohne Aktualisierung der Verknüpfungen geladen.
Gruss, Jogy

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige