ich hatte im April 2021 schon mal ein Thema erstellt. Hierzu bekam ich eine Hilfe über Power Query, wobei ich sagen muss dass ich mich mit den Befehlsarten etwas schwer tue. Bei meiner Excel-Aufstellung handelt es sich um eine Jahresauswertung mit 2015 Datensätzen.
Spalte A (Startdatum) Spalte B (Enddatum) Spalte C (Wert)
Das Start- bzw. Enddatum haben pro Datensatz immer unterschiedliche Werte und somit unterschiedliche Anzahl an Zeiträumen (Tagen) zwischen Start- und Enddatum. Der Wert (Spalte C) muss dann in dem Zeitraum von Start- bis Enddatum mit eingerechnet werden.
Am Ende möchte ich eine Auswertung für das ganze Jahr erstellen könne, wo ich sehen kann an welchem Tag dieses Zeitraums ich den höchsten Wert vorweisen kann.
Vielen Dank im Voraus für eure Antworten und die Hilfe.
danke für die schnelle Rückantwort. Nein, ich meine es etwas anders. An jedem Tag zwischen Startdatum und Enddatum muss ich den Wert aus Spalte C pro Datensatz voll mit einrechnen. Jetzt möchte ich wissen, an welchem Tag X innerhalb dieses Jahres ich den höchsten Wert rausbekomme.
Ich hab nochmal eine andere Datei mit weniger Datensätzen zur Veranschaulichung mitgeschickt.
Sub Zusammenfassung() Dim TB1 As Worksheet, TB2 As Worksheet, LR1 As Long, i As Long, LR2 As Long Dim Datum As Date, MMax As Double, Zeile As Long, Am As String Dim FirstAddr As String, C As Range
Set TB1 = Sheets("Tabelle1") Set TB2 = Sheets("Tabelle2")
'Reset With TB2 .UsedRange.ClearContents .Cells(1, 1) = "Datum" .Cells(1, 2) = "Summe" .Cells(1, 5) = "Max" .Cells(1, 6) = "An den Tagen" End With
With TB1 LR1 = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
For i = 2 To LR1 For Datum = .Cells(i, 1) To .Cells(i, 2) ' erste freie Zeile LR2 = TB2.Cells(TB2.Rows.Count, "A").End(xlUp).Row + 1
'Ist Datum schon vorhanden If WorksheetFunction.CountIf(TB2.Columns(1), Datum) = 0 Then
'noch nicht vorhanden, also anlegen TB2.Cells(LR2, 1) = Datum TB2.Cells(LR2, 2) = .Cells(i, 3) Else 'bereits da in Zeile Zeile = WorksheetFunction.Match(CDbl(Datum), TB2.Columns(1), 0) TB2.Cells(Zeile, 2) = TB2.Cells(Zeile, 2) + .Cells(i, 3)
End If Next Next End With With TB2 MMax = Application.Max(.Columns(2)) .Cells(2, 5) = MMax
'Tage zusammensetzen Set C = .Columns(2).Find(MMax, LookIn:=xlFormulas) If Not C Is Nothing Then FirstAddr = C.Address Do Am = Am & .Cells(C.Row, 1) & " / " Set C = .Columns(2).FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddr End If
'Letzte / weg und in Zelle schreiben .Cells(2, 6) = Left(Am, Len(Am) - 3)