Daten aus mehreren Excel Dateien auslesen

Question

Hallo,

ich habe leider nicht ganz so viel Ahnung von Excel und wende mich mit meinem Anliegen daher an euch:

Ich habe mehrere Ordner, die nach der Kalenderwoche sortiert sind.
In diesen Ordnern liegen mehrere Stundenzettel als Exceldateien.

Ich möchte jetzt eine Übersichtsdatei haben, in dem Tabellen automatisch generiert werden. Was soll da drin stehen?

Die Tabellen sollen die jeweilige KW als Überschrift haben. (Die ist ja als Ordnername vorhanden). Dann in der Tabelle soll stehen die Baustellenanschrift: (Feld=D9) und dann die Stundenanzahl (Feld=J24)

Dann wenn er alle Dateien ausgelesen hat soll die Gesamtstunden der Woche unter der Tabelle stehen.

Dann wenn er mit dem einen Ordner bzw. Woche fertig ist, soll er für den nächsten Ordner (KW) eine neue Tabelle anfertigen.

Eine Schwierigkeit ist, das meisten eine verschiedene Anzahl von Exceltabellen im Ordner liegen.

Ich bedanke mich schonmal im vorraus für eure Mühe.

MfG Kaelan

Answer 1

So damit du dir nicht umsonst den Kopf zerbrichst:

Ich habe das zusammenrechnen auch schon hinbekommen.

Was ich jetzt nur noch Optimiert habe ist, das er mir ein Sheet für jedes Jahr anlegt ( Ordner mit Jahreszahl als Namen vorrausgesetzt).

Dann habe ich gestern ein problem festgestellt:

Ich habe das alles mit Excel 2003 erstellt. Wenn ich das mit Excel 2010 ausführe sortiert er die KWs nicht Nummerisch. Was ziemlich blöd ist. Kann man das umgehen?

Was jetzt noch dazu kommt:

Ich möchte gerne das der Benutzer den Pfad der Stundenzettel am Anfang auswählen muss.

Ich möchte gerne das die Tabellen automatisch eingerahmt werden.

Das sollte es erst mal dann gewesen sein.

Das mit dem Pfad muss ich mir noch mal anschauen. Das kommt halt wenn man viel Googlet dann fällt einem sowas nicht auf.

MfG Kaelan

Answer 2

Moin,

Ahja, wusst ich es doch, dass Du das Zusammzaehlen auch noch hinbekommst. ;-)

Wenn ich mich denn da mal ranmache, dann habe ich nun doch noch die ein oder andere Frage:
[*] Wie ist denn Deine Verzeichnisstruktur mit den Stundenzetteln genau aufgebaut und benannt? (heissen die KW-Verzeichnisse nun 10.KW, oder KW10, oder 2011KW10 oder wie soll man sich das vorstellen?)
[*] liegen diese KW-Verzeichnisse alle in einem Verzeichnis?
[*] oder hast Du nun auch noch Jahresverzeichnisse (2007, 2008, etc.) und diese enthalten die jeweiligen KW-Unterverzeichnisse?
[*] "... Sheet für jedes Jahr anlegt ( Ordner mit Jahreszahl als Namen vorrausgesetzt). " Und was machst Du mit denen die keine Jahreszahl im Verzeichnisnamen haben?
[*] "...Benutzer den Pfad der Stundenzettel am Anfang auswählen muss" Du moechtest als den Pfad ("H:\Stundenzettel") nicht fest im Code hinterlegt haben, sondern dafuer eine Userauswahl? Machbar. Wenn die Mappe mit dem Code zur Zusammenfassung aber z.B. immer auf der obersten Ebene der Verzeichnisstruktur liegt, dann kann man sich die Userwahl auch sparen und ausgehend vom Pfad der Mappe selbst weitermachen. Wenn bei Dir die Zusammenfassung also in H:\Stundenzettel liegt, dann schreibe einfach strPfad = ThisWorkbook.Path im Code.

soweit erstmal
TheBlackBird ®

Answer 3

Ich habe dir mal eine Email geschickt mit der Datei als Anhang.

Da kannste dann den genauen Stand sehen.

Answer 4

Moin,

Ich habe Deine Mail erhalten und mir mal angeschaut, was Du da so geschrieben hast.
btw. Der Weg per Mail ist in einem Forum mMn nicht unbedingt der beste Weg. Du schliesst damit mMn automatisch andere potentielle Helfer von der Mitarbeit aus. Besser waere da evtl. doch der Weg ueber einen FileHoster wie in #5 bereits erwaehnt.

Aber sei es drum. Ich habe Dein Vorhaben in dieser Mappe einmal nachgebaut, so wie ich es handeln wollen wuerde. Beruecksichtigt wurde dabei die VerzeichnisStruktur, wie in Deiner Mappe (per Mail) beschrieben.


Den User-Auswahldialog zur VerzeichnisAuswahl habe ich dabei einmal bewusst weggelassen. Warum?
[*] Usereingriffe sind meist mit Fehlern verbunden, die abgefangen werden muessen. (Klick Dich einfach mal beim Dialog zu "C:\Programme" durch und klicke dort dann auf OK/Oeffnen.)
Nun wirst Du sagen: "Der User soll doch aber laut Sheet "Anleitung" etwas anderes waehlen..." Ja, sollte er. Da er aber die Moeglichkeit hat, einen Fehler zu machen, wird er dies frueher oder spaeter auch tun. ;-)
[*] Meine Mappe geht von ihrem eigenen Speicherort aus, und durchsucht von dort aus die von Dir vorgegebene Verzeichnisstruktur. (In Deiner Struktur der Mail-Mappe waere dies die Ebene "Stundenzettel". (Wie auch immer das Verzeichnis heisst, welches die JahresVerzeichnisse beinhaltet.))
Will der User die Zusammenfassung vom Desktop aus starten, darf er sich gern eine Verknuepfung zur Mappe dort hinlegen.

Grober Ablauf:
[*] Loeschen aller Sheets der Mappe bis auf jenes, welches da "Anleitung" heisst
[*] Durchlauf durch die Verzeichnisse (nur Verzeichnisse mit 4Ziffern als Name werden beruecksichtigt)
[*] (neu) Anlegen der Sheets fuer Verzeichnisse, welche da Unterverzeichnisse enthalten
[*] Durchlauf der Unterverzeichnisse (welche KW + 2Ziffern als Namen haben)
[*] Excel-Files des Unterverzeichnisses oeffen und Daten holen (danach File wieder schliessen)

Ich hoffe, so in etwa stellst Du Dir das vor. Und mit den Kommentaren im Code solltest Du Dich dann auch zurecht finden.

bis dahin einmal
TheBlackBird ®
... der ein klein wenig beeindruckt ist, was User mit "nicht ganz so viel Ahnung von Excel " und Google so auf die Beine stellen koennen. Programmieren scheint Dir nicht soooo ganz fremd zu sein. Kann das sein?

Answer 5

Ja das stimmt, ich habe Vorkenntnisse was Programmieren angeht ( C,C++,C#,HTML,PHP,Autoit).

Aber ich habe mir noch nie excel beigebracht.

Ich danke dir für deine Hilfe schon mal. Ich werde mir das heute Abend mal anschauen.

MfG Kaelan

Answer 6

kann leider die mappe nicht downloaden, da in meiner Firma die Seiten der Filehgoster gesperrt sind. :-(

deswegen hatte ich dir es ja auch per email geschickt.

Answer 7

Moin,

Ahja, daher der Weg per Mail. Da ich annehme, dass Du in der Firma weitertesten willst/wirst, zumindest legen die Zeiten Deiner Postings der letzten Tage dies nahe, schicke ich Dir das File dann auch mal per Mail zurueck. ;-)

Cu
TheBlackBird ®

Answer 8

Das wäre super muss nähmlich deinen Stand und meinen Stand zusammen bringen und dann noch mal die Tabellen um eine weitere Spalte erweitern, da ein Kollege noch eine sinnvolle Idee hatte. :-)

Answer 9

'===================================
'Daten sammeln
'===================================
For Each objSubfolder In objSubfolders 'Unterverzeichnisse durlaufen
If objSubfolder.Name Like "####" And _
objSubfolder.SubFolders.Count > 0 Then 'Wenn Unterverzeichnisname = 4Ziffern
Set wksDest = wbkDest.Sheets.Add _
(after:=wbkDest.Sheets(wbkDest.Sheets.Count), Type:=xlWorksheet) 'neues JahresSheet
wksDest.Name = objSubfolder.Name 'Name = Jahr
lngCol = 0 'Spaltenzaehler ruecksetzen
lngMaxRow = 0 'MaxZeile zuruecksetzen
For Each objSubSubFolder In objSubfolder.SubFolders 'UnterUnterverzeichnisse durchlaufen
If objSubSubFolder.Name Like "KW##" Then 'Wenn .Name = KW und 2 Ziffern
If lngCol = 0 Then 'Spaltenweiterschaltung
lngCol = lngCol + 1 'erste Spalte=1=A
Else
lngCol = lngCol + 4 'dann 4Spalten weiter
End If
wksDest.Cells(1, lngCol).Value = objSubSubFolder.Name 'Verzeinisname in Zelle
wksDest.Cells(1, lngCol).HorizontalAlignment = xlCenter 'ausrichten
wksDest.Cells(1, lngCol).Font.Bold = True 'Schrift Fett
wksDest.Range(Cells(1, lngCol), Cells(1, lngCol + 2)).Merge 'Zeilen zusammenfügen
wksDest.Cells(2, lngCol).Value = "Baustellenadresse" 'Kopf benennen
wksDest.Cells(2, lngCol).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(2, lngCol + 1).Value = "Stunden" 'Kopf benennen
wksDest.Cells(2, lngCol + 1).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(2, lngCol + 2).Value = "Betrag" 'Kopf benennen
wksDest.Cells(2, lngCol + 2).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum

lngRow = 4 'Zeile auf 4
For Each objFile In objSubSubFolder.Files 'StdZettel durchlaufen
If Right(objFile.Name, 5) Like "*xls*" Then 'Wenn ExcelFile
Set wbkSource = Workbooks.Open(objFile, , True, , , , , , , , False) 'File oeffen
Set wksSource = wbkSource.Worksheets("Tabelle1") 'Verweis auf T1 setzen
wksDest.Cells(lngRow, lngCol).Value = wksSource.Range("D9").Value 'Wert kopieren
wksDest.Cells(lngRow, lngCol).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngRow, lngCol + 1).Value = wksSource.Range("J24").Value 'Wert kopieren
wksDest.Cells(lngRow, lngCol + 1).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngRow, lngCol + 2).Value = wksSource.Range("S50").Value 'Wert kopieren
wksDest.Cells(lngRow, lngCol + 2).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wbkSource.Close False 'File schliessen ohne Speichern
Set wksSource = Nothing 'Object zerstoeren
Set wbkSource = Nothing 'Object zerstoeren
lngRow = lngRow + 1 'Zeilenweiterschaltung
If lngMaxRow < lngRow Then lngMaxRow = lngRow 'MaxZeile speichern
End If
Next objFile 'naechstes File
End If
Next objSubSubFolder 'naechstes UnterUnterverzeichnis
For lngCount = 1 To lngCol Step 4 'Summe vorbereiten
wksDest.Cells(lngMaxRow + 3, lngCount).Value = "Wochenstunden" 'Benennung in Zelle
wksDest.Cells(lngMaxRow + 3, lngCount).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngMaxRow + 4, lngCount).Value = "Überstunden" 'Benennung in Zelle
wksDest.Cells(lngMaxRow + 4, lngCount).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Range(Cells(lngMaxRow + 1, lngCount), Cells(lngMaxRow + 1, lngCount + 1)).Merge 'Zeilen zusammenfügen
wksDest.Cells(lngMaxRow + 1, lngCount).Value = "Gesamtbetrag" 'Bennenung in Zeile
wksDest.Range(Cells(lngMaxRow + 1, lngCount), Cells(lngMaxRow + 1, lngCount + 1)).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
] wksDest.Cells(lngMaxRow + 1, lngCount).Offset(0, 1).Value = _
Application.WorksheetFunction.Sum _
(wksDest.Range(wksDest.Cells(3, lngCount + 2), wksDest.Cells(lngMaxRow, lngCount + 2))) 'Summe in Zelle
wksDest.Cells(lngMaxRow + 1, lngCount + 2).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngMaxRow + 1, lngCount + 2).NumberFormat = "#,##0.00 $" 'Euro Formatierung
wksDest.Cells(lngMaxRow + 3, lngCount).Offset(0, 1).Value = _
Application.WorksheetFunction.Sum _
(wksDest.Range(wksDest.Cells(3, lngCount + 1), wksDest.Cells(lngMaxRow, lngCount + 1))) 'Summe in Zelle
wksDest.Cells(lngMaxRow + 3, lngCount + 1).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngMaxRow + 4, lngCount).Offset(0, 1).Value = _
wksDest.Cells(lngMaxRow + 3, lngCount).Offset(0, 1).Value - _
wbkDest.Worksheets("Anleitung").Range("D21") 'Ueberstunden rechnen
wksDest.Cells(lngMaxRow + 4, lngCount + 1).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
Next lngCount
wksDest.Columns.AutoFit 'Autofit
End If
Next objSubfolder

wbkDest.Worksheets("Anleitung").Activate 'Sheet Anleitung wieder aktivieren
Application.ScreenUpdating = True 'Bildschirm ein

'Objecte zerstoeren
Set wbkDest = Nothing
Set wksDest = Nothing
Set objFSO = Nothing
Set objFolder = Nothing
Se

Answer 10

'===================================
'Daten sammeln
'===================================
For Each objSubfolder In objSubfolders 'Unterverzeichnisse durlaufen
If objSubfolder.Name Like "####" And _
objSubfolder.SubFolders.Count > 0 Then 'Wenn Unterverzeichnisname = 4Ziffern
Set wksDest = wbkDest.Sheets.Add _
(after:=wbkDest.Sheets(wbkDest.Sheets.Count), Type:=xlWorksheet) 'neues JahresSheet
wksDest.Name = objSubfolder.Name 'Name = Jahr
lngCol = 0 'Spaltenzaehler ruecksetzen
lngMaxRow = 0 'MaxZeile zuruecksetzen
For Each objSubSubFolder In objSubfolder.SubFolders 'UnterUnterverzeichnisse durchlaufen
If objSubSubFolder.Name Like "KW##" Then 'Wenn .Name = KW und 2 Ziffern
If lngCol = 0 Then 'Spaltenweiterschaltung
lngCol = lngCol + 1 'erste Spalte=1=A
Else
lngCol = lngCol + 4 'dann 4Spalten weiter
End If
wksDest.Cells(1, lngCol).Value = objSubSubFolder.Name 'Verzeinisname in Zelle
wksDest.Cells(1, lngCol).HorizontalAlignment = xlCenter 'ausrichten
wksDest.Cells(1, lngCol).Font.Bold = True 'Schrift Fett
wksDest.Range(Cells(1, lngCol), Cells(1, lngCol + 2)).Merge 'Zeilen zusammenfügen
wksDest.Cells(2, lngCol).Value = "Baustellenadresse" 'Kopf benennen
wksDest.Cells(2, lngCol).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(2, lngCol + 1).Value = "Stunden" 'Kopf benennen
wksDest.Cells(2, lngCol + 1).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(2, lngCol + 2).Value = "Betrag" 'Kopf benennen
wksDest.Cells(2, lngCol + 2).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum

lngRow = 4 'Zeile auf 4
For Each objFile In objSubSubFolder.Files 'StdZettel durchlaufen
If Right(objFile.Name, 5) Like "*xls*" Then 'Wenn ExcelFile
Set wbkSource = Workbooks.Open(objFile, , True, , , , , , , , False) 'File oeffen
Set wksSource = wbkSource.Worksheets("Tabelle1") 'Verweis auf T1 setzen
wksDest.Cells(lngRow, lngCol).Value = wksSource.Range("D9").Value 'Wert kopieren
wksDest.Cells(lngRow, lngCol).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngRow, lngCol + 1).Value = wksSource.Range("J24").Value 'Wert kopieren
wksDest.Cells(lngRow, lngCol + 1).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngRow, lngCol + 2).Value = wksSource.Range("S50").Value 'Wert kopieren
wksDest.Cells(lngRow, lngCol + 2).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wbkSource.Close False 'File schliessen ohne Speichern
Set wksSource = Nothing 'Object zerstoeren
Set wbkSource = Nothing 'Object zerstoeren
lngRow = lngRow + 1 'Zeilenweiterschaltung
If lngMaxRow < lngRow Then lngMaxRow = lngRow 'MaxZeile speichern
End If
Next objFile 'naechstes File
End If
Next objSubSubFolder 'naechstes UnterUnterverzeichnis
For lngCount = 1 To lngCol Step 4 'Summe vorbereiten
wksDest.Cells(lngMaxRow + 3, lngCount).Value = "Wochenstunden" 'Benennung in Zelle
wksDest.Cells(lngMaxRow + 3, lngCount).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngMaxRow + 4, lngCount).Value = "Überstunden" 'Benennung in Zelle
wksDest.Cells(lngMaxRow + 4, lngCount).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Range(Cells(lngMaxRow + 1, lngCount), Cells(lngMaxRow + 1, lngCount + 1)).Merge 'Zeilen zusammenfügen
wksDest.Cells(lngMaxRow + 1, lngCount).Value = "Gesamtbetrag" 'Bennenung in Zeile
wksDest.Range(Cells(lngMaxRow + 1, lngCount), Cells(lngMaxRow + 1, lngCount + 1)).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
] wksDest.Cells(lngMaxRow + 1, lngCount).Offset(0, 1).Value = _
Application.WorksheetFunction.Sum _
(wksDest.Range(wksDest.Cells(3, lngCount + 2), wksDest.Cells(lngMaxRow, lngCount + 2))) 'Summe in Zelle
wksDest.Cells(lngMaxRow + 1, lngCount + 2).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngMaxRow + 1, lngCount + 2).NumberFormat = "#,##0.00 $" 'Euro Formatierung
wksDest.Cells(lngMaxRow + 3, lngCount).Offset(0, 1).Value = _
Application.WorksheetFunction.Sum _
(wksDest.Range(wksDest.Cells(3, lngCount + 1), wksDest.Cells(lngMaxRow, lngCount + 1))) 'Summe in Zelle
wksDest.Cells(lngMaxRow + 3, lngCount + 1).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
wksDest.Cells(lngMaxRow + 4, lngCount).Offset(0, 1).Value = _
wksDest.Cells(lngMaxRow + 3, lngCount).Offset(0, 1).Value - _
wbkDest.Worksheets("Anleitung").Range("D21") 'Ueberstunden rechnen
wksDest.Cells(lngMaxRow + 4, lngCount + 1).BorderAround ColorIndex:=0, Weight:=xlThin 'Rahmen rum
Next lngCount
wksDest.Columns.AutoFit 'Autofit
End If
Next objSubfolder

wbkDest.Worksheets("Anleitung").Activate 'Sheet Anleitung wieder aktivieren
Application.ScreenUpdating = True 'Bildschirm ein

'Objecte zerstoeren
Set wbkDest = Nothing
Set wksDest = Nothing
Set objFSO = Nothing
Set objFolder = Nothing
Set objSubfolders = Nothing
' Stop
End Sub

Ich habe es etwas angepasst für meine Bedürfnisse.(Habe nur das hier reinkopiert wo ich was geändert habe)
Aber ich habe nur was hinzugefügt nichts geändert was die Funktion beeinträchtigen könnte.

Nun habe ich mal getestet was passiert wenn ich schon mal einen Ordner „2012“ anlege mit einem Unterordner „KW01“.

Nun sagt mir der Debugger das im Bereich wo die Berechnung stattfindet ein Fehler ist.
Wenn ich jetzt aber im Ordner „KW01“ einen Stundenzettel einfüge klappt alles wunderbar .

Ich weiß aber nicht warum das so ist .
Mit freundlichen Grüßen

Kaelan

PS: Sorry für doppelpost baer oben vergessen als code zu posten