Summieren abhängig vom Monat und Zuordnungswert

  • Excel

Es gibt 10 Antworten in diesem Thema. Der letzte Beitrag () ist von peterfido.

    Summieren abhängig vom Monat und Zuordnungswert

    Hallo Community,

    ich bin gerade dabei eine kleine Funktion zu schreiben, aber hänge etwas an einer Summenfunktion.
    Aktuell werden aus mehreren Excel Tabellen die Sheets in die relevante Excel kopiert und unrelevante Spalten gelöscht.
    Nun bleiben 3 relevante Spalten (A: Datum | B: Wert | C: Zuordnung).
    Datum in dem Format: 01.01.2017
    Wert: Betrag in Euro
    Zuordnung: ein fest definierte Liste mit Zuordnungswerten z.B. Kostenstelle A

    Nun habe ich eine Tabelle auf einem anderen Tabellenblatt wo einfach die Spalten (Monate) und Zeilen (Kostenstellen) sind.
    Ich will nun die Tabelle füllen, was bedeutet die Werte müssen abhängig von Monat und Kostenstelle summiert werden und hier hänge ich.

    Wie kann ich Werte summieren, abhängig von Monat und Kostenstellen??

    Danke für eure Hilfe

    Danke für die schnelle Antwort und Hilfestellung. Wie kann ich das in VBA darstellen?

    Habe im Netz einen Code gefunden, der eine ganz gute Geschwindigkeit für große Tabellen haben soll, aber blicke da nicht ganz durch im bezug auf meine Anwendung

    Visual Basic-Quellcode

    1. Public Sub test()
    2. Dim arr
    3. Dim L As Long
    4. Dim objDic As Object
    5. Dim strtmp As String
    6. Dim Start As Double
    7. Start = Timer
    8. Set objDic = CreateObject("Scripting.Dictionary")
    9. arr = Range("A1").CurrentRegion
    10. Redim out(1 To UBound(arr), 1 To 1)
    11. For L = LBound(arr) To UBound(arr)
    12. strtmp = arr(L, 1) & "DUMMY" & arr(L, 6)
    13. objDic(strtmp) = objDic(strtmp) + arr(L, 8)
    14. out(L, 1) = objDic(strtmp)
    15. Next
    16. Range("I1").Resize(UBound(out)) = out
    17. Debug.Print Timer - Start
    18. End Sub

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „TeamBob“ ()

    Visual Basic-Quellcode

    1. Option Explicit
    3. Public Sub test()
    4. Dim arr
    5. Dim L As Long 'Zeile
    6. Dim objDic As Object 'Scripting.Dictionary
    7. Dim strtmp As String
    8. Dim Start As Double
    9. Start = Timer
    10. Set objDic = CreateObject("Scripting.Dictionary")
    11. arr = Range("A1").CurrentRegion
    13. 'Füllen des Scripting.Dictionary mit Keys und Werten
    14. For L = LBound(arr) + 1 To UBound(arr)
    15. '"Key" erstellen, Jahr_Monat (aus Spalte A) und Kostenstelle (aus Spalte C)
    16. strtmp = Year(arr(L, 1)) & "_" & Format(Month(arr(L, 1)), "00") & "_" & arr(L, 3)
    17. 'Wert (aus Spalte B) zu entsprechendem "Key" addieren
    18. objDic(strtmp) = objDic(strtmp) + arr(L, 2)
    19. Next
    21. L = 1
    22. ReDim out(1 To objDic.Count, 1 To 2)
    24. 'Umfüllen des Scripting.Dictionary in ein Array
    25. Dim key As Variant
    26. For Each key In objDic.Keys
    27. Debug.Print key, objDic(key)
    28. out(L, 1) = key
    29. out(L, 2) = objDic(key)
    30. L = L + 1
    31. Next key
    33. 'Ausgabe des Arrays (Titel und Summe)
    34. Range("I1:J2").Resize(UBound(out)) = out
    35. Debug.Print Timer - Start
    37. End Sub


    [Edit]Fehler in Codezeile 15 korrigiert.[/Edit]

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „HenryV“ ()

    Ja habe auch etwas rumgebastelt, aber bei der Methode bekomme ich immer einen Fehlermeldung:
    Laufzeitfehler "429".:Objekterstellung durch ActiveX-Komponente nicht möglich.

    Gibt es vielleicht eine andere Variante?
    Habe hier 3 Varianten probiert, aber erhalte immer eine Fehlermeldung "Typenkonflikt"

    Visual Basic-Quellcode

    1. Public Sub Test2()
    2. Dim r1 As Range
    3. Dim r2 As Range
    4. Dim r3 As Range
    6. Dim WS1 As Worksheet
    7. Dim WS2 As Worksheet
    9. Set WS1 = Worksheets("Tabelle1")
    10. Set WS2 = Worksheets("wodewa")
    12. Set r1 = Worksheets("Tabelle1").Range("A5:A20")
    13. Set r2 = Worksheets("Tabelle1").Range("D5:D20")
    14. Set r3 = Worksheets("Tabelle1").Range("B5:B20")
    16. '##Variante 1
    17. 'Sheets("wodewa").Range("B4") = WorksheetFunction.SumProduct((Month(Tabelle1.Range("A5:A20")=2)*(Tabelle1.Range("D5:D20")="Fahrzeugkosten")*(Tabelle1.Range("B5:B20"))
    19. '##Variante 2
    20. 'Sheets("wodewa").Range("B4") = WorksheetFunction.SumProduct((Month(r1) = 2) * (r2 = "Fahrzeugkosten") * (r3))
    22. '##Variante 3
    23. 'WS2.Cells(2, 4) = WorksheetFunction.SumProduct((Month(WS1.Range(WS1.Cells(1, 5), WS1.Cells(1, 20))) = 2) * (WS1.Range(WS1.Cells(4, 5), WS1.Cells(4, 20)) = "Fahrzeugkosten") * WS1.Range(WS1.Cells(2, 5), WS1.Cells(2, 20)))
    25. End Sub

    Ich habe jetzt einmal, den Code so angepasst, dass er die Werte aus "Tabelle1" nimmt und die Summe in die Tabelle "Übersicht" schreibt. (Übrigens "Februar" ist in "Tabelle1" falsch geschrieben.)
    Variante mit Scripting.Dictionary

    Visual Basic-Quellcode

    1. Public Sub test4567()
    3. Dim arr
    4. Dim L As Long 'Zeile
    5. Dim objDic As Object 'Scripting.Dictionary
    6. Dim strtmp As String
    7. Set objDic = CreateObject("Scripting.Dictionary")
    8. 'Wertetabellenbereich bestimmen
    9. 'arr = Range("A1").CurrentRegion
    10. arr = Worksheets("Tabelle1").Range("A5:C" & Worksheets("Tabelle1").Range("A5").CurrentRegion.Rows.Count)
    12. 'Füllen des Scripting.Dictionary mit Keys und Werten
    13. For L = LBound(arr) To UBound(arr)
    14. '"Key" erstellen, Monat (aus Spalte A) und Kostenstelle (aus Spalte C)
    15. strtmp = arr(L, 1) & "DUMMY" & arr(L, 3)
    16. 'Wert (aus Spalte B) zu entsprechendem "Key" addieren
    17. objDic(strtmp) = objDic(strtmp) + arr(L, 2)
    18. Next
    20. Dim key As Variant
    21. Dim sMonat As String
    22. Dim sKostenstelle As String
    23. Dim Spalte As Integer
    24. Dim Zeile As Integer
    25. Dim Wert As Double
    26. Dim c As Range
    28. For Each key In objDic.Keys
    29. sMonat = Split(key, "DUMMY")(0)
    30. sKostenstelle = Split(key, "DUMMY")(1)
    31. 'Suche der Monatspalte
    32. With Worksheets("Übersicht")
    33. Set c = .Range("B3:M3").Find(sMonat, LookIn:=xlValues)
    34. If Not c Is Nothing Then
    35. Spalte = c.Column
    36. End If
    37. 'Suche der Kostenzeile
    38. Set c = .Range("A4:A18").Find(sKostenstelle, LookIn:=xlValues)
    39. If Not c Is Nothing Then
    40. Zeile = c.Row
    41. End If
    42. 'Wert in Übersicht eintragen eventuell addieren
    43. If Zeile <> 0 And Spalte <> 0 Then
    44. .Cells(Zeile, Spalte).Value = objDic(key) '+ Worksheets("Übersicht").Cells(Zeile, Spalte).Value
    45. End If
    46. End With
    47. Spalte = 0
    48. Zeile = 0
    50. Next key
    52. End Sub


    Variante mit Evaluate

    Nur für Januar und Fahrzeugkosten

    Visual Basic-Quellcode

    1. Public Sub Test2()
    2. Worksheets("Übersicht").Range("B4").Value2 = Evaluate("SUMPRODUCT((Tabelle1!A5:A999=""Januar"")*(Tabelle1!C5:C999=""Fahrzeugkosten"")*Tabelle1!B5:B999)")
    3. End Sub


    Variante mit Excelformel

    Formel in Tabelle "Übersicht" in Zelle "B4" schreiben und in die restlichen Zellen kopieren

    Quellcode

    1. =SUMMENPRODUKT((Tabelle1!$A$5:$A$999=B$3)*(Tabelle1!$C$5:$C$999=$A4)*Tabelle1!$B$5:$B$999)

    Hallo und vielen Dank für die Hilfestellung.
    (1)
    Deine erste Version mit Scripting Dictionary funktioniert bei mir nicht, da ich immer die folgende Fehlermeldung erhalte:
    Laufzeitfehler "429".: Objekterstellung durch ActiveX-Komponente nicht möglich.

    (2)
    Die Zweite Version passt super. Wäre es hier sinnvoll diese so umzuschreiben, dass für den Monat und die Kostenstellen z.B. Fahrzeugkosten einfach 2 Variable genommen
    werden und dies dann als Schleife aufzuziehen? Also wie sieht es hier mit der Rechenzeit aus, da ich die vermutlich bessere Variante 1 nicht hinbekommen, aufgrund der Fehlermeldung,
    welche vermutlich nicht am Code liegt, sondern am aufruf der Funktion Scripting.Dictornary

    Wollte hier schleifen bauen so ungefähr, aber irgendwie nimmt er die Varible Kostenstelle nicht :(

    Visual Basic-Quellcode

    1. Public Sub Test2()
    2. Dim Kostenstelle As String
    3. Dim i As Integer
    5. For i = 4 to 17
    6. Kostenstelle = Worksheets("Übersicht").Range("A" & i).Value
    7. Worksheets("Übersicht").Range("B4").Value2 = Evaluate("SUMPRODUCT((Tabelle1!A5:A999=""Februar"")*(Tabelle1!C5:C999="Kostenstelle")*Tabelle1!B5:B999)")
    8. next i
    9. End Sub



    (3)
    Die 3 Variante es direkt in Excel zu lösen funktioniert prinzipiell auch, aber hier ist das Programm sehr überfordet und rechnet sehr lange.
    Das Problem ist, dass ich die Tabelle1 (Monat, Wert, Kostenstelle) aus einer anderen Excel importierte durch eine Funktion, welche das komplette Tabellenblatt kopiert.
    Dann werden durch eine Funktion die nicht relevanten Spalten gelöscht, sodass nur diese besagten 3 Spalten ürbig bleiben. Durch diesen "Daten-Import" und den lsöchen
    der Spalten habe ich immer den Fall, dass in der Tabelle "Übersicht" die Excel Funlktionen keine #Bezug mehr haben (selbst mit der Funktion "Indirekt". Weiterhin arbeiten
    diese Funktionen natürlich während des Datenimports und des löschen der Spalten, wodurch hier sehr lange gerechnet wird. Glaube das ist keine Option, dass ich hier lieber
    bei Variante 1-2 bleibe.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „TeamBob“ ()

    (2)
    bekomme ich keine Fehlermeldung, aber im Sheet schreibt er #Name
    Wenn ich statt der Variabel "Kostenstelle" den richtigen namen "Fahrzeugkosten" eingebe dann geht es. Muss also noch ein Fehler der Variabe sein.
    Habe die Variable Kostenstelle auch mal ausgeben lass, hier nimmt er wirklich "Fahrzeugkosten"

    Visual Basic-Quellcode

    1. i = 4
    2. Kostenstelle = Worksheets("Übersicht").Range("A" & i).Value
    3. Worksheets("Übersicht").Range("B4").Value2 = Evaluate("SUMPRODUCT((Tabelle1!A5:A999=""Februar"")*(Tabelle1!C5:C999=" & Kostenstelle & ")*Tabelle1!B5:B999)")

    Dateien am besten hier anhängen

    Hallo,

    wollte mir die Datei mal ansehen. Habe dann abgebrochen. Am besten Datei zippen und hier anhängen. Ohne Scripte läuft File-Upload nicht und mit will er folgendes öffnen:
    Bilder

    • File_Upload.jpg

      32,43 kB, 708×235, 85 mal angesehen
    Gruß
    Peterfido

    Keine Unterstützung per PN!

Facebook
Telefonspende