Daten aus verschiedenen Dateien in einer "Masterdatei" summieren

[gadgetsz]

Liebes Excelteam,

wir bräuchten eure Hilfe beim Erstellen eines Summen-"Mastersheets". Folgende Situation:

Wir haben 50 Mitarbeitende, welche über einen Zeitraum von einem Jahr einen sogenannten "Rapport" (Arbeitszeiterfassung) per Excel ausgefüllt haben. Die Studierenden haben dabei in 12 verschiedenen Tabellen (pro Monat eine Datei) ihre Zeit inkl. Kostenstelle rapportiert. Pro Tabelle gibt es einen Reiter "Summe", welcher die Kostenstellen dieses Rapportes zusammenführt. Zu Controllingzwecken würden wir nun gerne eine Abrechnung machen, welche all diese Summen (also 12x50 Dateien) in nur einer Excel-Datei zusammenfasst. Um die Struktur des Summensheets sowie die Dateibeschriftungslogik zu verstehen, haben wir euch mal vier Musterdateien angehängt. Aus Datenschutzgründen können wir leider die anderen Blätter der Dateien nicht teilen - wir denken aber, dass diese dafür nicht sondernlich relevant sind.

Da niemand von uns Erfahrungen mit tieferen Excelfunktionen (z.B. Makros) hat, dachten wir, dass wir hier an der richtigen Stelle sind!

Wir freuen uns auf eure Rückmeldungen!

Ps.: Könnte es eventuell ein Problem sein, dass die Spalte "Kostenstellen" nicht als solche betitelt ist? Leider ist dies ein Fehler, der sich nicht so leicht beheben lässt.

[Steffl]

Hallo,

wenn ich deine Datei aufrufe, sehe ich sehr viele Bezugsfehler.

[gadgetsz]

Danke für deine Antwort! Ich habe nun die Felder mit Daten gefüllt.

LG

[Steffl]

Hallo,

mein Vorschlag

Code:

ub prcEinlesen()
   Dim objDic As Object
   Dim lngC As Long, lngLastRow As Long, lngA As Long
   Dim strN?chsteMappe As String
   Dim vntSpalten As Variant, vntItem As Variant
  
   'die Spalten in denen die Kostenstellen stehen (hier Spalte B u. H)
   vntSpalten = Array(2, 8)
   Set objDic = CreateObject("scripting.dictionary")
   'gesucht wird in dem Verzeichnis in der die Masterdatei steht, nach Dateien, die mit dmu beginnen
   strN?chsteMappe = Dir(ThisWorkbook.Path & "\dmu*.*xls*")
   Do While strN?chsteMappe <> ""
      'die entsprechenden Dateien werden ge?ffnet
      Workbooks.Open ThisWorkbook.Path & "\" & strN?chsteMappe
      With ActiveWorkbook
         With .Worksheets(1)
            For lngA = 0 To UBound(vntSpalten)
               For lngC = 3 To .Cells(.Rows.Count, vntSpalten(lngA)).End(xlUp).Row
                  'wenn die Zellen einen numerischen Inhalt haben
                  If IsNumeric(.Cells(lngC, vntSpalten(lngA)).Value) Then
                     'wird die Kostenstelle und der Betrag eingelesen
                     objDic(.Cells(lngC, vntSpalten(lngA)).Value) = objDic(.Cells(lngC, vntSpalten(lngA)).Value) + WorksheetFunction.Sum(.Cells(lngC, vntSpalten(lngA) + 3).Resize(, 2).Value)
                  End If
               Next lngC
            Next lngA
         End With
      .Close False
      End With
      strN?chsteMappe = Dir()
   Loop
  
   lngC = 1
   'Ausgabe des Dictionary
   For Each vntItem In objDic.keys
      Cells(lngC, 1).Value = vntItem
      Cells(lngC, 2).Value = objDic(vntItem)
      lngC = lngC + 1
   Next vntItem
End Sub

[gadgetsz]

Super! Wäre es vielleicht möglich, dass du mir diesen Code in einem Excelsheet schickst? Wie gesagt, ich habe wirklich keine Ahnung wie/wo man sowas einfügt (und bei meinen Versuchen gerade gab es immer Syntax und Listenfehler).

Wäre das eine Möglichkeit? Würde mich sehr freuen!

[Steffl]

Hallo,

Super! Wäre es vielleicht möglich, dass du mir diesen Code in einem Excelsheet schickst?

Du hast von einer Masterdatei geschrieben, die aber bei deinen Anhängen nicht dabei war. Deshalb habe ich eine leere Exceltabelle hergenommen, den Code in einem allgemeinen Modul eingefügt und getestet. Nachdem es gepaßt hat, habe ich ihn hier gepostet. Die Datei existiert also nicht. Wie lautete der Syntaxfehler?

[gadgetsz]

Hi Steph,

leider finde ich diese Datei in die du den Code kopiert hast nicht. Wäre es dir vielleicht möglich, diese nochmal hier zu posten oder mir kurz erklären wo oder wie ich diesen Code einfüge?

LG

[WillWissen]

Hallo,

Stefan schrieb dir doch, dass er keine Datei hat.  

Code einfügen:
- mit Alt & F11 kommst du in den VBE
- links im Explorerfenster suchst du deine Datei und
- führst darauf einen Rechtsklick aus.
- Einfügen - Modul
- rechts öffnet sich ein großes Fenster, in das du den Code reinkopierst.

[gadgetsz]

Dieser Code funktioniert super!

Könnte vielleicht noch kurz jemand ergänzen, wie ich diesen Code nur auf Blätter mit dem Name "Kostenstellen Summary" reduzieren könnte?

Sub prcEinlesen()
  Dim objDic As Object
  Dim lngC As Long, lngLastRow As Long, lngA As Long
  Dim strNächsteMappe As String
  Dim vntSpalten As Variant, vntItem As Variant
 
  'die Spalten in denen die Kostenstellen stehen (hier Spalte B u. H)
  vntSpalten = Array(2, 8)
  Set objDic = CreateObject("scripting.dictionary")
  'gesucht wird in dem Verzeichnis in der die Masterdatei steht, nach Dateien, die mit dmu beginnen
  strNächsteMappe = Dir(ThisWorkbook.Path & "\dmu*.*xls*")
  Do While strNächsteMappe <> ""
      'die entsprechenden Dateien werden ge?ffnet
      Workbooks.Open ThisWorkbook.Path & "\" & strNächsteMappe
      With ActiveWorkbook
        With .Worksheets(1)
            For lngA = 0 To UBound(vntSpalten)
              For lngC = 3 To .Cells(.Rows.Count, vntSpalten(lngA)).End(xlUp).Row
                  'wenn die Zellen einen numerischen Inhalt haben
                  If IsNumeric(.Cells(lngC, vntSpalten(lngA)).Value) Then
                    'wird die Kostenstelle und der Betrag eingelesen
                    objDic(.Cells(lngC, vntSpalten(lngA)).Value) = objDic(.Cells(lngC, vntSpalten(lngA)).Value) + WorksheetFunction.Sum(.Cells(lngC, vntSpalten(lngA) + 3).Resize(, 2).Value)
                  End If
              Next lngC
            Next lngA
        End With
      .Close False
      End With
      strNächsteMappe = Dir()
  Loop
 
  lngC = 1
  'Ausgabe des Dictionary
  For Each vntItem In objDic.keys
      Cells(lngC, 1).Value = vntItem
      Cells(lngC, 2).Value = objDic(vntItem)
      lngC = lngC + 1
  Next vntItem
End Sub

[schauan]

Hallöchen,

im Prinzip statt

With .Worksheets(1)

dann

With .Worksheets("MeinName")

Falls es das Blatt nicht gibt, kommt allerdings eine Fehlermeldung und Du müsstest die Aktion abbrechen. Kann so ein Fall auftreten? Dann müsste man im Code entsprechend vorsorgen.