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.
Hallo,
wenn ich deine Datei aufrufe, sehe ich sehr viele Bezugsfehler.
Danke für deine Antwort! Ich habe nun die Felder mit Daten gefüllt.
LG
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
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!
Hallo,
(29.04.2020, 11:40)gadgetsz schrieb: [ -> ]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?
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
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.
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?
Zitat: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
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.