Tag/Nachtfahrten addieren bzw subtrahieren

Computer: Software & Programmierung Office Software
#21

Hallo giessel,
habe das Makro noch mal angepasst. Für die hochgeladene Datei habe ich das Ergebnis bis Zeile 1000 geprüft. Funktioniert prinzipiell. Die Zwischenzeilen, die ich als neue Schicht interpretiert hatte, müsste ich noch überarbeiten.
Vielleich kanns Du das Makro noch einmal an der Kopie eines anderen Datensatzes testen.
Gib mir bitte Bescheid, wenns Probleme beim Einbinden in Dein Excel-File gibt. Bei Excel 2010 musst Du eine Excel-Datei mit Makro als anderen Dateityp abspeichern. Ggf. musst Du auch noch die Sicherheitseinstellungen anpassen.
MfG MwieMichel

Option Explicit
’ Hier beginnt die Subroutine
Sub SchichtSumme()
’ Hier werden Variablen definiert
Dim APruefen As Variant, EPruefen As Variant 'Wert pruefen auf Datumsformat
Dim IstWahr As Boolean 'Wahr / Falsch Abfrage von Pruefen
Dim Start As Date, Ende As Date, Summe As Date 'Start, Ende und Differenz als Datum
Dim Schicht As Date, HelpDate As Date 'Schichtdauer und Kriterium fuer Schichtende
Dim DSpalteA As Integer, ZSpalteA As Integer 'Spaltenindex fuer Beginn (Datum und Zeit)
Dim DSpalteE As Integer, ZSpalteE As Integer 'Spaltenindex fuer Ende (Datum und Zeit)
Dim Zeile As Integer 'Zaehler fuer Zeilenvorschub
Dim SSpalte As Integer 'Zeiger fuer die Spalte in der die Summe stehen soll
’ Initialisieren oder Vorgaben fuer Variablen vergeben
Zeile = 1 'Anfang in Zeile 1
DSpalteA = 2 'Datum Anfang in Spalte 2
ZSpalteA = 3 'Zeit Anfang in Spalte 3
DSpalteE = 5 'Datum Ende in Spalte 5
ZSpalteE = 6 'Zeit Ende in Spalte 6
SSpalte = 13 'Summe in Spalte 18 schreiben
Schicht = „14:00“ 'Schicht dauert hoechstens 14 h
’ Finden des ersten Datums oder: Kopfzeilen filtern
APruefen = Cells(Zeile, DSpalteA).Value + Cells(Zeile, ZSpalteA).Value
Do Until IsDate(APruefen)
Zeile = Zeile + 1
APruefen = Cells(Zeile, DSpalteA).Value + Cells(Zeile, ZSpalteA).Value
Loop
Start = APruefen
EPruefen = Cells(Zeile, DSpalteE).Value + Cells(Zeile, ZSpalteE).Value
Ende = EPruefen
HelpDate = Start + Schicht
Do Until APruefen = „“
Do Until Ende > HelpDate
Zeile = Zeile + 1
EPruefen = Cells(Zeile, DSpalteE).Value + Cells(Zeile, ZSpalteE).Value
If Not IsDate(EPruefen) Then
Exit Do
End If
If EPruefen = „“ Then
Exit Do
End If
Ende = EPruefen
If Ende

#22

Hallo giessel,
vergiss mein letztes Makro. Nimm das hier:

Option Explicit
’ Hier beginnt die Subroutine
Sub SchichtSumme()
’ Hier werden Variablen definiert
Dim APruefen As Variant, EPruefen As Variant 'Wert pruefen auf Datumsformat
Dim IstWahr As Boolean 'Wahr / Falsch Abfrage von Pruefen
Dim Start As Date, Ende As Date, Summe As Date 'Start, Ende und Differenz als Datum
Dim Schicht As Date, HelpDate As Date 'Schichtdauer und Kriterium fuer Schichtende
Dim DSpalteA As Integer, ZSpalteA As Integer 'Spaltenindex fuer Beginn (Datum und Zeit)
Dim DSpalteE As Integer, ZSpalteE As Integer 'Spaltenindex fuer Ende (Datum und Zeit)
Dim Zeile As Integer 'Zaehler fuer Zeilenvorschub
Dim SSpalte As Integer 'Zeiger fuer die Spalte in der die Summe stehen soll
’ Initialisieren oder Vorgaben fuer Variablen vergeben
Zeile = 1 'Anfang in Zeile 1
DSpalteA = 2 'Datum Anfang in Spalte 2
ZSpalteA = 3 'Zeit Anfang in Spalte 3
DSpalteE = 5 'Datum Ende in Spalte 5
ZSpalteE = 6 'Zeit Ende in Spalte 6
SSpalte = 13 'Summe in Spalte 18 schreiben
Schicht = „16:00“ 'Schicht dauert hoechstens 16 h
’ Finden des ersten Datums oder: Kopfzeilen filtern
APruefen = Cells(Zeile, DSpalteA).Value + Cells(Zeile, ZSpalteA).Value
Do Until IsDate(APruefen)
Zeile = Zeile + 1
APruefen = Cells(Zeile, DSpalteA).Value + Cells(Zeile, ZSpalteA).Value
Loop
Start = APruefen 'Startdatum und Zeit belegen
EPruefen = Cells(Zeile, DSpalteE).Value + Cells(Zeile, ZSpalteE).Value
Ende = EPruefen 'Enddatum und Zeit belegen
HelpDate = Start + Schicht 'Maxdauer der Schicht belegen
Do Until APruefen = „“ 'Aufhören wenn Feld leer = Dateiende
Do Until Ende > HelpDate 'Zeile hochzählen bis Schichtende
Zeile = Zeile + 1
EPruefen = Cells(Zeile, DSpalteE).Value + Cells(Zeile, ZSpalteE).Value
If Not IsDate(EPruefen) Then
Zeile = Zeile + 1 'Wenn kein Datum dann nächste Zeile
EPruefen = Cells(Zeile, DSpalteE).Value + Cells(Zeile, ZSpalteE).Value
End If
If EPruefen = „“ Then
Exit Do 'Aufhören wenn Ende leer ist
End If
Ende = EPruefen
If Ende

#23

Hallo, MwieMichel
Vielen Dank für das Makro und die Mühen die Du gemacht hast.
Ich habe das Makro in 2 neuen Dateien eingebunden und es funktioniert,
in einer 3.Datei treten Probleme auf, werde versuchen es zu ergründen.
Bei der Durchsicht von 13000 Datensätzen habe ich auf den ersten Blick
keine Fehler entdeckt.Ist es richtig das das Makro nur in Spalte M schreibt??.Sollte ich Fehler entdecken melde ich mich noch mal.

Nochmals vielen Dank, das Makro hilft mir meine Arbeiten effizienter
zu gestalten

mfG Giessel

#24

Tag/Nachtfahrten: Problem mit Makro

Ich habe das Makro in 2 neuen Dateien eingebunden und es
funktioniert,

Das freut mich.

in einer 3.Datei treten Probleme auf, werde versuchen es zu
ergründen.

Das tut mir leid. Kannst Du sagen welcher Natur die Probleme sind? (Makro startet nicht, bricht ab, hängt sich auf, erzeugt nicht das erwünschte Ergebnis)

keine Fehler entdeckt.Ist es richtig das das Makro nur in
Spalte M schreibt??.Sollte ich Fehler entdecken melde ich mich
noch mal.

Ja, nur eine Spalte wird beschrieben, jeweils am letzten Eintrag der Schicht.

Nochmals vielen Dank, das Makro hilft mir meine Arbeiten
effizienter
zu gestalten

Freut mich, dass ich helfen konnte

mfG Giessel

MfG MwieMichel

#25

Hallo MwieMichel, ich habe den Fehler gefunden. Ich habe eine neue Datei
erstellt. Diese Datei ist noch ohne die Spalte D mit dem Entrag „T/N“.
Wenn ich dansch das Makro laufen lasse, funktioniert alles bestens, die
Spalte D kann auch ohne Daten sein und die Spalte M (Spalte 13 im Makro)
muss leer sein. Ich habe ein weitere Anliegen und kannst Du mir dabei helfen ??. Kann das Makro dahingehend erweitert werden, das in einer
weiteren Spalte die Fahrzeit pro Tag/Schicht addiert und in einer weiteren Spalte dann die Fahrzeit von der Schichtzeit/Arbeitszeit abgezogen wird, das wäre dann die Standzeit, die Datei/Tabelle wäre
dann für meine Zwecke perfekt. Über eine Pivot Tabelle bzw Was wäre wann
Berechnung kann ich dann meine Ziele umsetzen bzw Berechnungen anstellen.

Nochmals vielen vielen Dank für Deine bisherigen Bemühungen
MFG Giessel

#26

Hallo giessel,

Kann das Makro dahingehend erweitert
werden, das in einer
weiteren Spalte die Fahrzeit pro Tag/Schicht addiert und in
einer weiteren Spalte dann die Fahrzeit von der
Schichtzeit/Arbeitszeit abgezogen wird, das wäre dann die
Standzeit, die Datei/Tabelle wäre
dann für meine Zwecke perfekt. Über eine Pivot Tabelle bzw Was
wäre wann
Berechnung kann ich dann meine Ziele umsetzen bzw Berechnungen
anstellen.

ich habe das Makro erweitert und an der hochgeladenen Datei getestet. In Zeile 6643 springt die Startzeit im Datum. Das ist für die Schichtzeit kein Problem. Aber bei der Fahrtzeit entsteht einmalig eine Summe von über 23h. Das ergibt eine falsche Summe für die Fahrtzeit (die das Makro nicht entdeckt). Die Differenz allerdings läuft dann auf einen Fehler. Ich hänge das Makro hier trotzdem mal an.

Option Explicit
’ Hier beginnt die Subroutine
Sub SchichtSumme()
’ Hier werden Variablen definiert
Dim APruefen As Variant, EPruefen As Variant 'Wert pruefen auf Datumsformat, deshalb Variant
Dim IstWahr As Boolean 'Wahr / Falsch Abfrage von APruefen und EPruefen
Dim Start As Date, Ende As Date, Summe As Date 'Start, Ende und Schichtzeit als Datum
Dim Stand As Date, Fahrt As Date 'Fahrt und Standzeit als Datum
Dim Schicht As Date, HelpDate As Date 'max. Schichtdauer und Kriterium fuer Schichtende
Dim DSpalteA As Long, ZSpalteA As Long 'Spaltenindex fuer Beginn (Datum und Zeit)
Dim DSpalteE As Long, ZSpalteE As Long 'Spaltenindex fuer Ende (Datum und Zeit)
Dim FSpalte As Long 'Spaltenindex für Fahrtzeiten
Dim Zeile As Long 'Zaehler fuer Zeilenvorschub
Dim SSpalte As Long, FSSpalte As Long, STSpalte As Long 'Spalten für Schicht, Fahrt, Stand
’ Initialisieren oder Vorgaben fuer Variablen vergeben
Zeile = 1 'Anfang in Zeile 1
DSpalteA = 2 'Datum Anfang in Spalte 2
ZSpalteA = 3 'Zeit Anfang in Spalte 3
DSpalteE = 5 'Datum Ende in Spalte 5
ZSpalteE = 6 'Zeit Ende in Spalte 6
FSpalte = 7 'Fahrtzeitsumme in Spalte 7
SSpalte = 13 'Summe der Schicht in Spalte 13
FSSpalte = 14 'Summe der Fahrtzeiten in Spalte 14
STSpalte = 15 'Differenz als Standzeit in Spalte 15
Schicht = „16:00“ 'Schicht dauert hoechstens 16 h
’ Finden des ersten Datums oder: Kopfzeilen filtern
With ActiveWorkbook.ActiveSheet
APruefen = Cells(Zeile, DSpalteA).Value + Cells(Zeile, ZSpalteA).Value
Do Until IsDate(APruefen)
Zeile = Zeile + 1
APruefen = Cells(Zeile, DSpalteA).Value + Cells(Zeile, ZSpalteA).Value
Loop
Start = APruefen 'Startdatum und Zeit belegen
EPruefen = Cells(Zeile, DSpalteE).Value + Cells(Zeile, ZSpalteE).Value
Ende = EPruefen 'Enddatum und Zeit belegen
Fahrt = Cells(Zeile, FSpalte).Value
HelpDate = Start + Schicht 'Maxdauer der Schicht belegen
Do Until APruefen = „“ 'Aufhören wenn Feld leer = Dateiende
Do Until Ende > HelpDate 'Zeile hochzählen bis Schichtende
Zeile = Zeile + 1
EPruefen = Cells(Zeile, DSpalteE).Value + Cells(Zeile, ZSpalteE).Value
If Not IsDate(EPruefen) Then
Zeile = Zeile + 1 'Wenn kein Datum dann nächste Zeile
EPruefen = Cells(Zeile, DSpalteE).Value + Cells(Zeile, ZSpalteE).Value
End If
If EPruefen = „“ Then
Exit Do 'Aufhören wenn Ende leer ist
End If
Ende = EPruefen
Fahrt = Fahrt + Cells(Zeile, FSpalte).Value
If Ende

#27

Hallo MwieMichel,danke für die Erweiterung des Makros. Ich konnte mich
bisher leider nicht melden, habe das Makro in neuen Dateien ausprobiert
und es funktoniert bestens. Der von Dir beschriebene Fehler kann vorkommen, liegt vermutlich an der Übertragung aus dem Taxamter (inkonsistente Daten). Nochmals vielen Dank und ein schönes Weihnachtsfest und alles Gute im neuen Jahr

MfG Giessel