Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1872to1876
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1872to1876
1872to1876
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA Tage trennen um Mitternacht

VBA Tage trennen um Mitternacht
08.03.2022 08:48:30
MartyMcFly
Hallo,
ich bin auf der Suche nach einem VBA Code der es mir ermöglicht Zeitstempel, welche Tagesübergreifend sind, nach Tagen zu splitten.
Meine Aufgabe:
Ich soll Zeiten von Mitarbeitern nach Tagen auswerten. Das lässt sich natürlich leicht über eine Pivot Tabelle einrichten.
Mein Problem:
Die Zeiten die ich auswerten soll trennen die Tage nicht nach Mitternacht deutscher Zeit. Die Daten wurden nämlich ursprünglich in pazifischer Zeit erfasst und automatisch in die lokale Zeit umgerechnet. Daher erfolgt die Trennung um 09:00 Uhr unserer Zeit, womit ich natrülich nichts anfangen kann. Diese Zeitstempel Daten können mitunter sehr umfangrech sein und von 10000 bis 500000 Zeilen enthalten. Der generelle Aufbau ist allerdings immer derselbe.
Was ich benötige:
Ich bräuchte ein VBA script das durch alle vorhandenen Zeilen geht und bei jeder Zeile, die ein anderes Enddatum als das Startdatum hat, eine neue Zeile einfügt beginnend bei Enddatum 00:00 bis ursprüngliches Enddatum und in der Ursprungszeile das Enddatum auf das Startdatum 00:00 setzt und den Zeitunterschied in beiden Zeilen neuberechnet. Damit sollten die Tage korrekt getrennt sein und auch für mich korrekt auszuwerten sein.
Ich habe eine Beispieldatei hochgeladen, welche den Ist- und den Sollzustand abbildet.
https://www.herber.de/bbs/user/151620.xlsx
Ich hoffe es findet sich jemand der mir hier weiterhelfen kann.

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Tage trennen um Mitternacht
08.03.2022 09:49:52
Yal
Moin Marty,
probiere folgendes 

Sub Zeiten_teilen()
Dim i As Long
With Worksheets("Timestamps - Sheet")
For i = .Range("A1").End(xlDown).Row To 2 Step -1
If Int(.Cells(i, "G"))  Int(.Cells(i, "H")) Then
.Rows(i).Copy
.Rows(i).Insert Shift:=xlDown
.Cells(i + 1, "G") = Int(.Cells(i + 1, "H"))
.Cells(i, "H") = Int(.Cells(i, "H"))
.Cells(i, "K") = DateDiff("n", .Cells(i, "G"), .Cells(i, "H"))
.Cells(i + 1, "K") = DateDiff("n", .Cells(i + 1, "G"), .Cells(i + 1, "H"))
End If
Next
End With
End Sub
Es wird davon ausgegangen, dass in Zeile 1 ein Header ist, mindestens die Zeile 2 befüllt ist und die Spalte A vollständig befüllt ist (von Zeile 2 bis letzte) .
VG
Yal
Anzeige
AW: VBA Tage trennen um Mitternacht
08.03.2022 09:51:38
UweD
Hallo
hier meine Lösung

Sub Zwischenzeit()
Dim Sp1 As Integer, SpD As Integer, Z1 As Integer, LR As Long, i As Long
Sp1 = 7 'Spalte G
SpD = 11 'Differenzspalte
Z1 = 2 'erste Datenzeile
LR = Cells(Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
For i = LR To Z1 Step -1
If Int(Cells(i, Sp1))
LG UweD
AW: VBA Tage trennen um Mitternacht
08.03.2022 10:20:30
Daniel
Hi
bei der Datenmenge würde ich hier über Arrays gehen.
da die Daten temporär verdoppelt werden, ist 500.000 Zeilen Ausgangsdaten das Maximum was verarbeitet werden kann.

Sub test()
Dim arr1
Dim arr2
Dim z As Long, s As Long
arr1 = Cells(1, 1).CurrentRegion
ReDim Preserve arr1(1 To UBound(arr1, 1), 1 To UBound(arr1, 2) + 1)
arr2 = arr1
For s = 1 To UBound(arr2, 2)
arr2(1, s) = ""
Next
For z = 2 To UBound(arr1, 1)
If Int(arr1(z, 7)) = Int(arr1(z, 8)) Then
For s = 1 To UBound(arr2, 2)
arr2(z, s) = ""
Next
arr1(z, 12) = z
Else
arr1(z, 8) = Int(arr1(z, 8))
arr2(z, 7) = Int(arr2(z, 8))
arr1(z, 11) = Round((arr1(z, 8) - arr1(z, 7)) * 60 * 24, 0)
arr2(z, 11) = Round((arr2(z, 8) - arr2(z, 7)) * 60 * 24, 0)
arr1(z, UBound(arr1, 2)) = z
arr2(z, UBound(arr1, 2)) = z
End If
Next
Cells(1, 1).Resize(UBound(arr1, 1), UBound(arr1, 2)) = arr1
Cells(1, 1).Offset(UBound(arr1, 1), 0).Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
ActiveSheet.UsedRange.Sort key1:=Cells(1, UBound(arr1, 2)), order1:=xlAscending, Header:=xlYes
ActiveSheet.Columns(UBound(arr1, 2)).ClearContents
End Sub
Gruß Daniel
Anzeige
AW: VBA Tage trennen um Mitternacht
08.03.2022 11:41:25
ChrisL
Hi
Hier mittels Power-Query (PQ):
https://www.herber.de/bbs/user/151626.xlsx
(Datumsdifferenzberechnung ist noch nicht ganz optimal, aber funktioniert)
Für grössere Datenmengen bestens geeignet und das Resultat kann auch direkt ins Datenmodell geladen werden, um daraus eine Pivot zu erzeugen bzw. die Gruppierung könnte auch innerhalb PQ erfolgen. Damit müssten keine umfangreichen Zwischenresultate erzeugt werden.
Bei Interesse PQ Intro-Video schauen und bei Bedarf nachfragen.
cu
chris
AW: VBA Tage trennen um Mitternacht
08.03.2022 15:13:21
MartyMcFly
Vielen Dank für die schnellen Lösungen. Über Power Query hatte ich noch gar nicht nachgedacht, allerdings steht mir diese Option auch noch nicht lange zur Verfügung. (Firma hat kürlich erst eine "aktuelle" Office Version angeschafft.) Ich habe jetzt noch nicht alle Lösungen angewandt, denke aber, daß sie alle zum Ziel führen. Daher wird es dann wahrscheinlich auch eine Performance Frage werden, welche Lösung am Ende von mir genutzt wird.
Ich werde dann auch nochmal Rückmeldung geben welche es am Ende geworden ist. ☺
Nochmals danke an Yal, UweD, Daniel und ChrisL. ☺
Anzeige
AW: VBA Tage trennen um Mitternacht
08.03.2022 15:17:46
Daniel
nochmal ne Frage: kann der Zeitraum eigentlich auch über drei oder mehr Tage gehen?
Gruß Daniel
AW: VBA Tage trennen um Mitternacht
08.03.2022 18:23:24
MartyMcFly
Du meinst z.B. vom 21.03. 09:00 bis 23.03. oder 24.03.15:00? Das kann nicht vorkommen. Soweit ich weiß ist das Maximum in einer Zeile dann ein Zeitraum von 24 Stunden. Also vom 21.03. von 09:00 bis 22.03. 09:00. Die nächste Zeile wäre dann entsprechend vom 22.03. 09:00 bis 23.03. 09:00 usw.. Das folgt dann immer der Trennung der Tage um Mitternacht nach pazifischer Zeit.
AW: VBA Tage trennen um Mitternacht
08.03.2022 18:54:32
Daniel
Hi
nochmal ne Variante mit einer etwas anderen Herangehensweise.
Ein Performancevergleich über die verschiedenen Varianten mit deiner maximalen Anzahl an Zeilen würde mich interessieren, insbesondere auch der Unterschied meiner beiden Varianten:

Sub test()
Dim spL As Long
Dim rng1 As Range, rng2 As Range
With Cells(1, 1).CurrentRegion
spL = .Columns.Count
With .Columns(spL).Offset(0, 1).Resize(, 2)
.Columns(1).FormulaR1C1 = "=Row()"
.Columns(2).FormulaR1C1 = "=IF(Int(RC7)=Int(RC8),0,""x"")"
.Formula = .Value
End With
End With
With Cells(1, 1).CurrentRegion
.Sort Key1:=.Cells(1, spL + 2), order1:=xlAscending, Header:=xlYes
Set rng1 = Intersect(.Cells, .Columns(spL + 2).SpecialCells(xlCellTypeConstants, 2).EntireRow)
rng1.Copy rng1.Offset(rng1.Rows.Count)
Set rng2 = rng1.Offset(rng1.Rows.Count)
With rng1.Columns(8)
.FormulaR1C1 = "=Int(RC7)+1"
.Formula = .Value
End With
With rng2.Columns(7)
.FormulaR1C1 = "=Int(RC8)"
.Formula = .Value
End With
With Union(rng1.Columns(11), rng2.Columns(11))
.FormulaR1C1 = "=Round((RC8-RC7)*24*60, 0)"
.Formula = .Value
End With
End With
With Cells(1, 1).CurrentRegion
.Sort Key1:=.Cells(1, spL + 1), order1:=xlAscending, Header:=xlYes
.Columns(spL + 1).Resize(, 2).ClearContents
End With
End Sub
diese Variante sollte auch mehr als 500.000 Zeilen verarbeiten können, sofern mit der Gesamtzahl am Schluss die 1,04 Mio Zeilen nicht überschritten wird.
Gruß Daniel
Anzeige
AW: VBA Tage trennen um Mitternacht
09.03.2022 07:52:43
MartyMcFly
Morgen,
ich habe die VBA Skripte zum einen über eine Datei mit der üblichen Größe von 65243 Zeilen (Zeitraum eine Woche) und zum anderen dann über den maximalen Zeitraum, welcher mir im Moment zur Verfügung steht, mit 348604 Zeilen (Zeitraum 6 Wochen) laufen lassen. Letzteres wird nicht häufig Anwendung finden, aber kann durchaus vorkommen.
1 Woche:
Yal: 2 Minuten 31 Sekunden
UweD: 51,3 Sekunden
Daniel1: 3,1 Sekunden
Daniel2: 1,9 Sekunden
6 Wochen:
Yal: nicht getestet
UweD: 20 Minuten 47 Sekunden
Daniel1: 12,8 Sekunden
Daniel2: 4,3 Sekunden
Dazu muss ich sagen, dass dies die Ergebnisse des Firmenrechners sind und mit der Stoppuhr im Handy festgehalten wurden. Andere Rechner durchlaufen das ganze vermutlich schneller, aber an der Hardware kann ich nun mal nichts ändern. Ich habe die Ergebnisse stichprobenartig kontrolliert und mir auch jeweils die Zeilenanzahl des Ergebnisses angeschaut. Die Zeilenanzahl war bei allen am Ende gleich. Wie vermutet funktionieren also alle Lösungen.
Für meinen Anwendungsfall von einer Woche, wären alle Lösungen praktikabel gewesen und ich danke allen nocheinmal für die Mühe und das schnelle Feedback. Es ist glaube ich offensichtlich welche Lösung zum Einsatz kommen wird.
Die PowerQuery Möglichkeit behalte ich auf jeden Fall auch im Hinterkopf.
Anzeige
Danke für deine Rückmeldung
09.03.2022 08:26:24
Daniel
HI
kleiner Tipp noch:
wenn du die Laufzeit eines Makros messen willst, kannst du folgendes verwenden:

Dim T as Single
T = Timer
Call Makro_das_du_stoppen_willst
Msgbox Timer - T,, "Laufzeitmessung"
(die zwei Kommas sind absicht)
Statt der Messagebox kannst du das Ergebis auch im Direktfenster ausgeben lassen, ist manchmal hilfreich, wenn man mehrere Messungen macht.
dann:

Debug.Print "Makroname", Timer - T
Gruß Daniel
AW: VBA Tage trennen um Mitternacht
09.03.2022 08:53:21
Yal
Hallo Marty,
die wohl ausführlichste Rückmeldung, die ich je gesehen habe. Nicht nur jede Variante getestet, sondern auch noch gestoppt. Das ist benchmark.
Im Moment weiss ich nicht, ob Power Query gut passen würde: das Erzeugen von neue Zeilen "dazwischen" stelle ich mir auswendig vor. Muss ich als Projekt vornehmen ;-)
Eine Zusatzidee: falls deine Quelle in csv-Form vorliegt, könnte anstatt en block zu öffnen, Zeile für Zeile, dafür inkl. Behandlung. Da wäre die Bearbeitungszeit schon drin.
VG
Yal
Anzeige
AW: VBA Tage trennen um Mitternacht
09.03.2022 09:03:06
ChrisL
Hi Yal
Mit den Zwischenzeilen hatte ich weniger Mühe.

={[von]..[bis]}
Da ich die Datumswerte als Ganzzahlen behandelt habe, brauchte es eine Typenkonvertierung und Rundung.

= {Number.RoundDown(Number.From([Sekunde von Local Start Time])) ..Number.RoundDown(Number.From([Sekunde von Local End Time]),0) }
Mit der eigentlichen Logik für die Differenzberechnung habe ich mich schwerer getan bzw. die intuitive Herangehensweise hat dann zu diesem Bandwurm geführt. Könnte man sicherlich noch etwas optimieren.

= if Number.RoundDown([Sekunde von Local Start Time],0)  = Number.RoundDown([Sekunde von Local End Time],0)  then [Sekunde von Local End Time]-[Sekunde von Local Start Time] else if (Number.RoundDown([Sekunde von Local Start Time],0)   [Date] and Number.RoundDown([Sekunde von Local End Time],0)  [Date])  then 1 else if Number.RoundDown([Sekunde von Local Start Time],0) =[Date] then [Date]+1-[Sekunde von Local Start Time] else [Sekunde von Local End Time]-[Date]
cu
Chris
Anzeige
Power Query
09.03.2022 12:14:10
Yal
Moin zusammen,
ich bin vom Power Query nicht berauscht...
Falls jemand was besseres suchen möchte:

let
Quelle = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content],
#"Geänderter Typ" = Table.TransformColumnTypes(Quelle,{{"Organization", type text}, {"Work City", type text}, {"Staffing Market", type text}, {"Staffing Type", type text}, {"Rep ID", Int64.Type}, {"Rep Name", type text}, {"Sekunde von Local Start Time", type datetime}, {"Sekunde von Local End Time", type datetime}, {"Status", type text}, {"Status Change Reason", type text}, {"Time in status (min)", Int64.Type}}),
#"Hinzugefügte benutzerdefinierte Spalte" = Table.AddColumn(#"Geänderter Typ", "Benutzerdefiniert", each Table.FromRecords(if Date.Day([Sekunde von Local Start Time]) = Date.Day([Sekunde von Local End Time]) then
{[Start=[Sekunde von Local Start Time], End=[Sekunde von Local End Time]]}
else
{[Start=[Sekunde von Local Start Time] , End=Date.StartOfDay([Sekunde von Local End Time])],[Start=Date.EndOfDay([Sekunde von Local Start Time]) ,End=[Sekunde von Local End Time]]}, {"Start", "End"})),
#"Erweiterte Benutzerdefiniert" = Table.ExpandTableColumn(#"Hinzugefügte benutzerdefinierte Spalte", "Benutzerdefiniert", {"Start", "End"}, {"Start", "End"}),
#"Geänderter Typ1" = Table.TransformColumnTypes(#"Erweiterte Benutzerdefiniert",{{"Start", type datetime}, {"End", type datetime}}),
#"Neu angeordnete Spalten" = Table.ReorderColumns(#"Geänderter Typ1",{"Organization", "Work City", "Staffing Market", "Staffing Type", "Rep ID", "Rep Name", "Start", "End", "Status", "Status Change Reason", "Time in status (min)"}),
#"Entfernte Spalten" = Table.RemoveColumns(#"Neu angeordnete Spalten",{"Sekunde von Local Start Time", "Sekunde von Local End Time", "Time in status (min)"}),
#"Umbenannte Spalten" = Table.RenameColumns(#"Entfernte Spalten",{{"Start", "Sekunde von Local Start Time"}, {"End", "Sekunde von Local End Time"}}),
#"Hinzugefügte benutzerdefinierte Spalte2" = Table.AddColumn(#"Umbenannte Spalten", "Duration", each (
Date.Day([Sekunde von Local End Time]) - Date.Day([Sekunde von Local Start Time])
+ (Time.Hour([Sekunde von Local End Time]) -Time.Hour([Sekunde von Local Start Time])) / 24
+ (Time.Minute([Sekunde von Local End Time]) - Time.Minute([Sekunde von Local Start Time])) / 1440
+ (Time.Second([Sekunde von Local End Time]) -Time.Second([Sekunde von Local Start Time])) / 86400) * 1440),
#"Geänderter Typ2" = Table.TransformColumnTypes(#"Hinzugefügte benutzerdefinierte Spalte2",{{"Duration", Int64.Type}})
in
#"Geänderter Typ2"
VG
Yal
Anzeige

Links zu Excel-Dialogen

MessageBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige