18.10.2013

13451

Excel Dateien per Makro zusammenfassen und ordnen

Hallo werte Forums-Community!

Ich habe momentan mit folgendem Problem zu kämpfen:

Ein Ausgangsordner C:\Users\JaZo27\TestName befinden sich Excel-Dateien, die alle aus einem Sheet bestehen und gleich aufgebaut sind. Ich würde nun gerne per Makro alle im Ordner befindlichen Excel-Dateien in einer Arbeitsmappe zusammenfassen. Jede importierte Datei in einem neuen Tabellenblatt. Zum Abschluss möchte ich gerne eine Liste erstellen, die bestimmte Werte aus den Tabellenblättern zusammenfasst.

Also in der Liste soll dann z.B in A3 der Wert von Tabelle1!C6 stehen, in C3 der Wert von Tabelle1!C33, usw.. in A4 dann Tabelle2!C6, usw

Ich habe mal per Aufzeichmakro erste Gehversuche gestartet, würde mich aber über eure Inputs sehr freuen.

Danke schonmal an alle die sich die Mühe machen meinen Beitrag zu lesen und gegebenenfalls auch zu antworten.

Gruss
JaZo27

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 219805

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

Ausgedruckt am: 22.11.2024 um 21:11 Uhr

21 Kommentare

Neuester Kommentar

Hallo JaZo27!

Das könnte anhand Deiner Beispieldaten etwa so gehen:

Sub Zusammenfassen()
Pfad = "D:\Dein Ordner"  
AbZeile = 3 'ab dieser Zeile die Übersicht im ersten Tabellenblatt der Sammeltabelle erstellen (entsprechend Deinem Beispiel "A3")  

Set Sammel = ThisWorkbook 'Sammeldatei merken  
SammelName = LCase(ThisWorkbook.Name) 'Dateinamen der Sammeltabelle merken  
Set fso = CreateObject("Scripting.FileSystemObject")  

For Each Datei In fso.GetFolder(Pfad).Files 'alle Dateien des Ordners durchgehen  
    Dateityp = fso.GetExtensionName(Datei.Name) 'Dateityp ermitteln  
    If Left(LCase(Dateityp), 3) = "xls" Then 'nur Excel-Dateien verarbeiten  
        If LCase(Datei.Name) <> SammelName And LCase(Datei.Name) <> "~$" & SammelName Then 'Sammeldatei nicht verarbeiten  
            Dateiname = fso.GetBaseName(Datei.Name) 'Dateinamen der aktuellen Datei merken  
            Workbooks.Open Filename:=Datei.Path 'Datei öffnen  
            Sheets(1).Move After:=Sammel.Sheets(Sammel.Sheets.Count) 'erstes Blatt als letztes Blatt in Sammelmappe einfügen  
            Sammel.Sheets(Sammel.Sheets.Count).Name = Dateiname 'Namen des eingefügten Blattes auf den Dateinamen der Herkunftsdatei setzen  
            Workbooks(Datei.Name).Close (False) 'Datei schließen (ohne speichern)  
        End If
    End If
Next

With Sammel
    Set Uebersicht = .Sheets(1) 'Übersichtstabelle merken  
    Versatz = AbZeile - 2 'für Berechnung Zeilennummer verwendet  
    For i = 2 To .Sheets.Count 'alle Blätter nach dem Übersichtsblatt durchgehen  
        BlattName = .Sheets(i).Name 'Blattnamen merken  
        'Formeln zum Übernehmen der Werte eintragen  
        Uebersicht.Cells(i + Versatz, "A").Formula = "=" & BlattName & "!C6" 'Spalte ("A" im Übersichtsblatt) und zu übernehmende Zelle ("C6") anpassen  
        Uebersicht.Cells(i + Versatz, "C").Formula = "=" & BlattName & "!C33" 'Spalte ("C" im Übersichtsblatt) und zu übernehmende Zelle ("C33") anpassen  
    Next
End With
End Sub

Du hast zwar die übernommenen Blätter "Tabelle1" und "Tabelle2" genannt, ich fände aber den Namen der Datei, aus der das Blatt stammt, informativer (lässt sich auf Wunsch aber natürlich wieder auf "Tabelle#" ändern) ...

Das Makro ist in die "Sammel"-Datei einzufügen und von dort aus zu starten.

Grüße
bastla

Hallo bastla!

Vielen Dank für den Code!

Meine Überlegung bezüglich der Tabellennamen war folgende:

Die files haben zum Teil sehr lange Namen und ich war mir nicht sicher, wieviele Zeichen ein Reiter verträgt. Deswegen der Umweg über Tabelle1,2...

Ich gebe dir Recht, dass es informativer wäre, die Reiter nach den importierten Dateien zu benennen, aber beim Testen stellte sich heraus, nur 31 Zeichen pro Reiter. Schade.

Hab jetzt ein paar Dateien zum Testen umbenannt, konnte allerdings noch keinen Erfolg erzielen, da eine Fehlermeldung mit "Laufzeitfehler 9" erscheint. (Zeile 17)

Woran könnte das liegen?

Besten Dank für deine Hilfe

Gruss
JaZo27

Hallo JaZo27!

Den Fehler kann ich nicht nachvollziehen, aber falls er weiterhin auftreten sollte, ersetze testweise die Zeile durch

Workbooks(Workbooks.Count).Close False

Für die Benennung der Tabellen mit einer fortlaufenden Bezeichnung / Nummer könntest Du folgende angepasste Variante versuchen:

Sub Zusammenfassen()
Pfad = "D:\Dein Ordner"  
AbZeile = 3 'ab dieser Zeile die Übersicht im ersten Tabellenblatt der Sammeltabelle erstellen (entsprechend Deinem Beispiel "A3")  

Set Sammel = ThisWorkbook
SammelName = LCase(ThisWorkbook.Name) 'Dateinamen der Sammeltabelle merken  
Set fso = CreateObject("Scripting.FileSystemObject")  

TabName = "Tabelle" 'konstanter Teil der neuen Tabellennamen  
Nr = 101 'Startwert für Nummer in den Tabellennamen  
For Each Datei In fso.GetFolder(Pfad).Files 'alle Dateien des Ordners durchgehen  
    Dateityp = fso.GetExtensionName(Datei.Name) 'Dateityp ermitteln  
    If Left(LCase(Dateityp), 3) = "xls" Then 'nur Excel-Dateien verarbeiten  
        If LCase(Datei.Name) <> SammelName And LCase(Datei.Name) <> "~$" & SammelName Then 'Sammeldatei nicht verarbeiten  
            Dateiname = fso.GetBaseName(Datei.Name) 'Dateinamen der aktuellen Datei merken  
            Workbooks.Open Filename:=Datei.Path 'Datei öffnen  
            Sheets(1).Move After:=Sammel.Sheets(Sammel.Sheets.Count) 'erstes Blatt als letztes Blatt in Sammelmappe einfügen  
            Sammel.Sheets(Sammel.Sheets.Count).Name = TabName & Nr 'Namen des eingefügten Blattes setzen  
            Nr = Nr + 1 'Nummer für Tabellennamen erhöhen  
            Workbooks(Datei.Name).Close (False)
        End If
    End If
Next

With Sammel
    Set Uebersicht = .Sheets(1)
    Versatz = AbZeile - 2
    For i = 2 To .Sheets.Count
        BlattName = .Sheets(i).Name
        Uebersicht.Cells(i + Versatz, "A").Formula = "=" & BlattName & "!C6" 'Spalte ("A") und zu übernehmende Zelle ("C6") anpassen  
        Uebersicht.Cells(i + Versatz, "C").Formula = "=" & BlattName & "!C33" 'Spalte ("C") und zu übernehmende Zelle ("C33") anpassen  
    Next
End With
End Sub

Grüße
bastla

Moin JaZo27 und bastla,

zu dem Problem der Länge des Reiternamens bzw, des Laufzeitfehlers 9 noch ein paar Hinweise.

- ja, die fest voreingestellte maximale Länge des Reiternamens ist bei allen Excelversionen 31 Zeichen.
- und es dürfen/sollten einige Zeichen nicht verwendet werden wie Doppelpunkt :, Schrägstrich (/) ,Backslash (\), Wildcards (? und *) oder ein Apostroph als erstes Zeichen
- ein Teil dieser Konventionen wird auch als Fehlermeldung angezeigt, wenn bei "Arbeitsblatt umbenennen" etwas derartiges eingegeben wird

Zusätzliche Hürde ist allerdings, dass die Redmonder schon seit jeher kleinere Probleme mit der Länge von Dateinamen haben und vor allem nicht mehr als zwei Summanden gleichzeitig bei einer Addition im Auge behalten können.

Deshalb kann der Laufzeitfehler auch verursacht werden durch die Gesamtlänge von (Laufwerk+Pfad+Dateiname der Exceldatei), die kleiner als 218 Zeichen plus der Länge eines Arbeitsblattnamen ( max. 31) + 3 ( ein bis drei Zeichen werden als Trenner zwischen Arbeitsmappennamen und Reiternamen benötigt).

Die Gesamtsumme der Einzelsummanden (= max217 plus max31 plus max3 ) wiederum darf nur 235 sein, sonst lassen sich keine Verknüpfungen zu diesen Tabellen anlegen.
Diese Rechenregel wird mal bekannt werden als "Redmondsche Algebra" oder "das Theorem der PraktikantInnen"

Deshalb solltest du, JaZo27, diese Exceldatei mal in einem "kurzen" Verzeichnis (D:\temp) daraufhin prüfen, ob der Laufzeitfehler auch dort auftritt.
Ich vermute nämlich, die Datei liegt bei dir im Moment unter "C:\Users\Dokumente und Einstellungen\noch\vierbisfünf\weitere\Ebenen\", bei bastla dagegen auf d:\Temp.

Wenn die Datei aber im "Echtbetrieb" auf einem ziemlich langen Dateinamen (z.B. ein Servershare) liegen muss, dann würde ich dieses Gesamtlängen-Limit im Hinterkopf behalten.

Grüße
Biber

Guten Morgen bastla und Biber!

Danke für eure Hinweise.

Ich bin jetzt mal dem Tipp von Biber gefolgt und hab die Dateien in ein "kurzes" Verzeichnis kopiert und auch mit "kurzen" Namen benannt.

Wie mir scheint ist dies allerdings nicht die Ursache für den Laufzeitfehler 9, da er immer noch wie zuvor auftritt.

Der Versuch

Workbooks(Datei.Name).Close (False)

mit

Workbooks(Workbooks.Count).Close (False)

zu ersetzen hat auch nicht den gewünschten Erfolg erzielt. Die Arbeitsmappe wird dabei ganz geschlossen.

Die erste Datei des Ordners wird wie gewünscht eingefügt, beim Sprung auf die zweite Datei scheint irgendwo der Fehler zu liegen.

Vielen Dank für eure Bemühungen und schönen Tag!
Gruss
JaZo27

Hallo JaZo27!

Unabhängig davon, dass (ohne konkrete Beispiele für die von Dir verwendeten Dateinamen etwas schwierig zu testen) der genannte Fehler bei mir weiterhin nicht auftritt: Hast Du es schon mit meinem zweiten Ansatz versucht?

Grüße
bastla

Hmm,

Sir Arthur C. Doyle lässt doch mal seinen Protagonisten sinngemäß sagen:
"Wenn alle andere anderen Möglichkeiten ausgeschlossen werden, dann muss es die letzte verbleibende sein - wie unwahrscheinlich diese auch sein mag."

Ich tippe deshalb auf folgendes Szenario:
- bei irgendeinem Testlauf/Skriptabbruch ist eine der zu verarbeitenden (Quell-)Excel-Dateien nicht geschlossen worden und hat deshalb noch eine temporäre Datei im Verszeichnis stehen lassen (zum Zeichen, dass jemand diese gerade editiert.). Name dieser temporären Datei ist sowas wie "~$"+erkennbar viel vom Dateinamen plus Extension xls/xls?"

- da diese Datei nicht weggefiltert wird im For-Each-Konstrukt wird sie dann auch "als normale Exceldatei" geöffnet - und beim Schliessen geht natürlich jedes Workbook.Close auf die Bretter,

Verifizieren liesse sich das, wenn mal vor der Absturz-Zeile eine Ausgabe des Dateinamens erfolgen würde:

   ...
  Debug.Print "Dateiname = " & Datei.Name & " bzw "  & ActiveWorkbook.Name   
  Workbooks(Datei.Name).Close (False) ...

Abstellen liesse es sich, wenn diese Zeile

.. IF ... And LCase(Datei.Name) <> "~$" & SammelName Then

... sinngemäß geändert werden würde auf

..IF ... And Substr(Datei.Name, 1, 2 ) <> "~$" Then

Wenn die Ursache noch abgedrehter ist, dann habe ich auch keine Idee mehr.

Grüße
Biber

... wobei sich in VBx für derlei die Schreibweise

If LCase(Datei.Name) <> SammelName And Left(LCase(Datei.Name), 1) <> "~" Then 'Sammeldatei nicht verarbeiten

bewährt hat

...

Grüße
bastla

warum muss denn der arme VBS-Schnipsel auf die Tilde ein LCase() machen?
Ginge auch ein UCase()?

Grüße zurück
Biber

@ Biber

.... warum muss denn der arme VBS-Schnipsel

Damit er's mal zum VBA-Schnipsel bringt?

Aber klar: Egal ob "LCase" oder "UCase" - Käs' isses hier auf jeden Fall ...

Grüße
bastla

@ bastla

...viellleicht implementieren die PraktikantInnen uns ja noch ein "ICase" ( nein, kein Walfischleder-Etui fürs iPhone, sondern ein "IgnoreCase").

Aber bis dahin ist bestimmt aus "Visual Basic for Applications" schon ein "Visual Basic for Widgets" geworden...

Ich werde mir auch deine Schreibweise "VBx" angewöhnen.

Grüße
Biber

@ Biber

...vielleicht implementieren die PraktikantInnen uns ja noch ein "ICase"

Naja, StrComp() mit der Option vbTextCompare wäre zwar etwas in der Art, ist mir aber (aus noch nicht geklärten Gründen

) irgendwie unsympathisch ...

Grüße
bastla

@ bastla

Das wär auch nix für mich....

Wie du schon festgestellt hast - diese LKäs' und UKäs'-Funktionen klingen sympathisch - diese Laute könnten dir auch in Stogart oder Hesse zu Ohren kommen und "UKäs'" sogar in der Fernsehwerbung ("... der leichte You-Käs mit linksdrehenden Kolibakterien...").

Aber "strComp()" klingt ja schon, als hätte ich das Mittagessen bei meiner Ex-Schwiegermutti probiert...

Grüße
Biber

Hallo bastla, hallo Biber!

@ bastla

Ja ich habe auch den zweiten Ansatz schon versucht, leider mit dem gleichen Ergebnis: Laufzeitfehler 9

Die Dateien sind wie folgt benannt 1234AB_Name_Zusatzinfo.xls. Name sowie Zusatzinfo haben unterschiedliche Länge: 5678DC_Ganzlangername_13_2_9, 1245F_Name_5, usw.

@ Biber

Ich hab mal die Zeile mit dem

Debug.Print "Dateiname = " & Datei.Name & " bzw " & ActiveWorkbook.Name

eingefügt, mir ist allerdings nicht ganz klar, wo die Ausgabe des Namens erfolgt?

Bitte verzeiht mein Unwissen, aber es handelt sich hier um meine ersten Versuche in VBA

Danke für eure Vorschläge
Grüsse
JaZo27

Hallo JaZo27!

Ändere Zeile 14 auf

If LCase(Datei.Name) <> SammelName And Left(Datei.Name, 1) <> "~" Then 'Sammeldatei und Temp-Dateien nicht verarbeiten

... wo die Ausgabe des Namens erfolgt?

Im "Direktfenster" (Menü "Ansicht" bzw Strg-G; angezeigt wird als Fenstertitel "Direktbereich") des VBA-Editors ...

Grüße
bastla

Hallo bastla!

Im Direktfenster erscheint

Dateiname = 1234AB_Kopie von Testname.xls bzw Zusammenfassung_Liste.xlsm

und wieder der schon bekannte Laufzeitfehler 9.

Guss
JaZo27

Moin JaZo27,

hmm, eine Idee hätte ich noch - nämlich wenn bei bastlas Tests alle Arbeitsmappen plus die Sammelmappe in einem Verzeichnis liegen und bei deinem Szenario alle Quell-Dateien in einem und die Sammelmappe in einem anderen.

Dann spendieren wir noch eine Variable mehr aus Ängstlichkeit:

Sub Zusammenfassen()
Pfad = "D:\Dein Ordner"  
AbZeile = 3 'ab dieser Zeile die Übersicht im ersten Tabellenblatt der Sammeltabelle erstellen (entsprechend Deinem Beispiel "A3")  

Set Sammel = ThisWorkbook
SammelName = LCase(ThisWorkbook.Name) 'Dateinamen der Sammeltabelle merken  
Set fso = CreateObject("Scripting.FileSystemObject")  

TabName = "Tabelle" 'konstanter Teil der neuen Tabellennamen  
Nr = 101 'Startwert für Nummer in den Tabellennamen  
For Each Datei In fso.GetFolder(Pfad).Files 'alle Dateien des Ordners durchgehen  
    Dateityp = fso.GetExtensionName(Datei.Name) 'Dateityp ermitteln  
    If Left(LCase(Dateityp), 3) = "xls" Then 'nur Excel-Dateien verarbeiten  
        If LCase(Datei.Name) <> SammelName And Left(Datei.Name, 1) <> "~" & SammelName Then 'Sammeldatei und Temp-Dateien nicht verarbeiten  
            Dateiname = fso.GetBaseName(Datei.Name) 'Dateinamen der aktuellen Datei merken  
            ' # ##alt  Workbooks.Open Filename:=Datei.Path 'Datei öffnen  
            Set nextWb = Workbooks.Open(Datei.Path)  'nächste Import-Datei öffnen und nextWb zuweisen  
            '  # ##alt  Sheets(1).Move After ....  
            nextwB.Sheets(1).Copy After:=Sammel.Sheets(Sammel.Sheets.Count) 'erstes Blatt als letztes Blatt in Sammelmappe einfügen  
            Sammel.Sheets(Sammel.Sheets.Count).Name = TabName & Nr 'Namen des eingefügten Blattes setzen  
            Nr = Nr + 1 'Nummer für Tabellennamen erhöhen  
           '  # ##alt              Workbooks(Datei.Name).Close (False)  
            nextwB.Close (False)
        End If
    End If
Next

With Sammel
    Set Uebersicht = .Sheets(1)
    Versatz = AbZeile - 2
    For i = 2 To .Sheets.Count
        BlattName = .Sheets(i).Name
        Uebersicht.Cells(i + Versatz, "A").Formula = "=" & BlattName & "!C6" 'Spalte ("A") und zu übernehmende Zelle ("C6") anpassen  
        Uebersicht.Cells(i + Versatz, "C").Formula = "=" & BlattName & "!C33" 'Spalte ("C") und zu übernehmende Zelle ("C33") anpassen  
    Next
End With
End Sub

Jeweils die Zeilen unterhalb der drei Zeilen mit " ' # ##alt " sind - bezogen auf bastlas oben geposteten Code - anzupassen.

Wenn es das auch nicht ist, dann müssen wir mal warten, bis ein Experte hier vorbeikommt.

Grüße
Biber

Heho Bastla und Biber,

ich versuche seit einer Weile einen Makro zu finden, mit dem ich aus einem Ordner mehrere Excel-Datein in ein Datenblatt einer Sammeldatei untereinander schreiben kann. Eure hier angegebene Lösung kommt dem denke ich schon sehr nach, wobei ich denke das meine Vorstellungen ja eigentlich einfacher sind. Nur leider weiß ich nicht, wie ich die ausgelesenen Daten untereinander schreiben kann.
In den auszulesenden Excel-Datein gibt es immer nur ein Datenblatt mit dem gleichen Aufbau, wobei die Zeilen jedoch variieren können.
Ich wäre über jede Hilfe sehr dankbar.

Liebe Grüße
Ramba

Hallo RambaZamba und willkommen im Forum!

Das könnte etwa so gehen:

Sub Zusammenfassen()
Pfad = "D:\Dein Ordner"  
QAbZeile = 1 'ab dieser Zeile die Daten auslesen  
ZAbZeile = 3 'ab dieser Zeile die Daten eintragen  

Set Sammel = ThisWorkbook 'Sammeldatei merken  
SammelName = LCase(ThisWorkbook.Name) 'Dateinamen der Sammeltabelle merken  
Set SammelBlatt = Sammel.Sheets(1) 'Sammel-Tabelle merken  
Set fso = CreateObject("Scripting.FileSystemObject")  

ZZeile = ZAbZeile 'Startzeile für Sammelblatt übernehmen  
For Each Datei In fso.GetFolder(Pfad).Files 'alle Dateien des Ordners durchgehen  
    Dateityp = fso.GetExtensionName(Datei.Name) 'Dateityp ermitteln  
    If Left(LCase(Dateityp), 3) = "xls" Then 'nur Excel-Dateien verarbeiten  
        If LCase(Datei.Name) <> SammelName And Left(Datei.Name, 1) <> "~" Then 'Sammeldatei und Temp-Dateien nicht verarbeiten  
            Dateiname = fso.GetBaseName(Datei.Name) 'Dateinamen der aktuellen Datei merken  
            Set nextWb = Workbooks.Open(Datei.Path) 'nächste Quell-Datei öffnen und nextWb zuweisen  
            QZeile = QAbZeile 'Startzeile für Quelldatei setzen  
            With nextWb.Sheets(1) 'mit dem 1. Blatt der Quelldatei arbeiten  
                Do While .Cells(QZeile, "A") <> "" 'solange in Spalte A Werte stehen  
                    .Rows(QZeile).EntireRow.Copy SammelBlatt.Cells(ZZeile, "A") 'ganze Zeile kopieren  
                    QZeile = QZeile + 1 'Zeilennummer Quelldatei erhöhen  
                    ZZeile = ZZeile + 1 'Zeilennummer Zieldatei erhöhen  
                Loop
            End With
            nextWB.Close (False) 'Quelldatei schließen  
        End If
    End If
Next
End Sub

Grüße
bastla

Hey Bastla,

es funktioniert überragend! So wie ichs mir vorgestellt habe.

Du hast mir echt eine ganz schöne Arbeit ersparrt. Wäre mit meinen VBA-Kentnissen echt baden gegangen. Vielen Dank für die schnelle Hilfe.

Grüße Ramba