Office: Differenz zwischen 2 Datum berechnen

florianb · 20. Oktober 2020

woher soll checkdate wissen in welchem Bereich du prüfst wenn du das optionale Argument nicht mitgibst?
z.b. CheckDate(dteValue, 14)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ja, hab ich verstanden. Ist auch logisch. Hab ich umgesetzt

und dann kommen wir zum nächsten Punkt. im checkdate solltest du erstmal prüfen welches Argument denn jetzt mitgekommen ist.

if Days14...... is nothing oder ungleich "" oder oder

ein optionales Argument sollte reichen und im checkdate wertest du es aus und steuerst damit deine Rückgabewerte
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Tut mir leid, aber ich verstehe es einfach nicht. Vielleicht denke ich zu kompliziert. Aber er will die Berechnungen nicht durchführen

florianb · 20. Oktober 2020

ich habe es mal mit einer DateDiff Version versucht. Leider auch ohne Erfolg.

Code:

Dim rngSource As Range
Dim lngCnt1 As Long
Dim lngCnt2 As Long
Dim lngCnt3 As Long
Dim lngCnt4 As Long
Dim rng As Range
Dim cell As Range

Set rngSource = Worksheets("aktuelle Tickets").Range("I2:I1000")

For Each rng In rngSource
If Not rng.Value = "" Then
If CheckDate(Days, 60) Then
' gleich oder älter als 60 Tage
lngCnt4 = lngCnt4 + 1

ElseIf CheckDate(Days, 21) Then
' gleich oder älter als 21 Tage
lngCnt3 = lngCnt3 + 1

ElseIf CheckDate(Days, 14) Then
' gleich oder älter als 14 Tage
lngCnt2 = lngCnt2 + 1
Else
' jünger als 14 Tage
lngCnt1 = lngCnt1 + 1
For Each cell In rng
cell.Interior.ColorIndex = 6
Next
End If
End If
Next

Worksheets("Daten").Range("B20").Value = lngCnt1
Worksheets("Daten").Range("B21").Value = lngCnt2
Worksheets("Daten").Range("B22").Value = lngCnt3
Worksheets("Daten").Range("B23").Value = lngCnt4
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Public Function CheckDate(ByVal dteValue As Date, Optional Days As Long) As Boolean

dteValue = Int(dteValue) ' Nur Datumsanteil verwenden

Datum = DateDiff("d", Date, dteValue)

If Datum
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

knobbi38 · 20. Oktober 2020

Hallo Florian,

1.)
wenn es bereits eine Funktion Checkdate() gibt, paßt man den Aufruf dieser Funktion nach seinen Bedürfnissen an und nicht umgekehrt die bereits getestete Funktion. *frown.gif* In einem echten Projekt müßte danach die veränderte Funktion nochmal getestet und qualitätsgesichert werden! Das hat nichts mehr mit wiederverwendbarem Code zu tun!

2.)
immer "Option Explicit" in jedem Modul verwenden!

3.)
In deinem letzten Beispiel mit DateDiff sollte der zurückgegebene Wert dem deklarierten Rückgabewert der Funktion entsprechen, also eine als boolean definierte Funktion kann keinen Integer Wert zurückgeben!

4) Variablennamen sollten nicht einem Name einer VBA-Funktion entsprechen, auch nicht der deutschsprachigen Übersetzung, wie z.B. Datum, Date usw. Das führt nur zu Verwechslungen und erschwert die Lesbarkeit.

Hier mal ein Beispiel, wie so eine Funktion angewendet werden kann:
Code:

Dim wks As Worksheet
Dim rngSource As Range
Dim rng As Range

Set wks = Worksheets("Tabelle1")
Set rngSource = wks.Range("B4", wks.Range("B4").End(xlDown))

Application.ScreenUpdating = False

For Each rng In rngSource

' Alter in Tagen
rng.Offset(0, 1).Value = rng.Value - Date

' Alter < 14 Tage
rng.Offset(0, 2).Value = Not (CheckDate(rng.Value, 14))

' Alter 14 - 21 Tage
rng.Offset(0, 3).Value = CheckDate(rng.Value, 14) And Not CheckDate(rng.Value, 22)

' Alter 22 - 60 Tage
rng.Offset(0, 4).Value = CheckDate(rng.Value, 22) And Not CheckDate(rng.Value, 61)

' Alter > 60 Tage
rng.Offset(0, 5).Value = CheckDate(rng.Value, 61)

' Kategorie
rng.Offset(0, 6).Value = CheckDate2(rng.Value, 14, 22, 61)
Next

Application.ScreenUpdating = True
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mit ein bißchen boolescher Algebra kann Checkdate() auch für Bereiche verwendete werden, aber wie schon angedeutet, ist sie dafür eigentlich nicht konzipiert.

Deshalb gibt es jetzt die Funktion CheckDate2(), die in dem obigen Beispiel auf Bereichsgrenzen prüft und einen entsprechenden Index zurück gibt. Wird kein Bereich gefunden, wird der Wert -1 zurückgegeben Die Bereiche müssen dabei aufsteigend sortiert übergeben werden!
Code:

' ------------------------------------------------------------------------------
' CheckDate2(Datum, Arg1, Arg2, ...)
' Prüft, ob ein Datum innerhalb einer Altersgrenze bezogen auf das aktuelle
' Datum liegt.
' Argumente:
' Datum : das zu prüfende Datum
' Arg1, Arg2, ..., ArgN : Altersgrenzen in Tagen austeigend sortiert.
' Rückgabe:
' -1 : wenn das Datum außerhalb der Altergrenzen liegt
' 0..n : Indexwert der Altersgrenze
' ------------------------------------------------------------------------------
Public Function CheckDate2( _
ByVal dteValue As Date, _
ParamArray Days()) As Long
Dim i As Long

CheckDate2 = -1

For i = 0 To UBound(Days)
If Int(dteValue) + Days(i) > Date Then
' Datum ist jünger als Days(i) Tage
CheckDate2 = i
Exit For
End If
Next
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Anbei eine kleine Demo zum probieren. Zum besseren Verständnis kannst du ja mal die Funktionen im Einzelschritt duchgehen und dabei im Lokalfenster die Werte der Variablen beobachten.

Gruß Ulrich

knobbi38 · 20. Oktober 2020

\@ralf_bx:
Wenn die Funktionsdeklaration

Public Function CheckDate(ByVal dteValue As Date, Optional Days14 As Long = 14, Optional Days21 As Long = 21, Optional Days60 As Long = 60) As Boolean

lautet, müssen die Argumente nicht noch mit

if Days14...... is nothing oder ungleich ""

geprüft werden. Ein Long-Wert kann niemals Nothing oder Leerstring sein, das war schon richtig, aber in dem Beispiel stimmte einfach der Datentyp des Funktionsrückgabewertes nicht.

Gruß Ulrich

florianb · 21. Oktober 2020

Ich habe zwar einige Zeit gebraucht um den (für mich) sehr komplizierten Code zu verstehen. Ich habe ihn dann ein wenig umgeschrieben und eine If ElseIf Verzweigung eingebaut. Nun funktioniert es super. Vielen Dank Ulrich

Code:

Dim wks As Worksheet
Dim rngSource As Range
Dim rng As Range
Dim lngCnt1 As Long
Dim lngCnt2 As Long
Dim lngCnt3 As Long
Dim lngCnt4 As Long

Set wks = Worksheets("aktuelle Tickets")
Set rngSource = wks.Range("I2", wks.Range("I2").End(xlDown))

For Each rng In rngSource
' Alter < 14 Tage
If Not (CheckDate(rng.Value, 14)) Then
lngCnt1 = lngCnt1 + 1

' Alter 14 - 21 Tage
ElseIf CheckDate(rng.Value, 14) And Not CheckDate(rng.Value, 22) Then
lngCnt2 = lngCnt2 + 1

' Alter 22 - 60 Tage
ElseIf CheckDate(rng.Value, 22) And Not CheckDate(rng.Value, 61) Then
lngCnt3 = lngCnt3 + 1

' Alter > 60 Tage
ElseIf CheckDate(rng.Value, 61) Then
lngCnt4 = lngCnt4 + 1
End If
Next

Worksheets("Daten").Range("B22").Value = lngCnt1
Worksheets("Daten").Range("B23").Value = lngCnt2
Worksheets("Daten").Range("B24").Value = lngCnt3
Worksheets("Daten").Range("B25").Value = lngCnt4
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Public Function CheckDate( _
ByVal dteValue As Date, _
Optional Days As Long = 7) As Boolean

dteValue = Int(dteValue) ' Nur Datumsanteil verwenden
dteValue = dteValue + Days ' Prüfdatum berechnen

' Vergleich durchführen und Rückgabewert setzen:
CheckDate = (dteValue
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

knobbi38 · 21. Oktober 2020

Hallo Florian,

so paßt das schon viel besser. *Smilie

Warum muss ich immer ein "Option Explicit" einfügen?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mit Option Explicit wird man gezwungen, jede Variabel zu deklarieren und dabei den Datentyp gleich mit festzulegen. So werden Tippfehler bei den Variablennamen vermieden und es werden die Datentypen beim Kompilieren gleich mit überprüft. Viele Fehler werden so schon im Vorfeld eleminiert.
Siehe auch: Option-Explicit-Statement

Hier die Variante mit der Checkdate2() Funktion bei gleicher Funktionalität:
Code:

Dim wks As Worksheet
Dim rngSource As Range
Dim rng As Range
Dim alngCnt(3) As Long
Dim i As Long

Set wks = Worksheets("aktuelle Tickets")
Set rngSource = wks.Range("I2", wks.Range("I2").End(xlDown))

For Each rng In rngSource
i = CheckDate2(rng.Value, 14, 22, 61) + 1
alngCnt(i) = alngCnt(i) + 1
Next

With Worksheets("Daten")
.Range("B23").Value = alngCnt(1) ' Alter < 14 Tage
.Range("B24").Value = alngCnt(2) ' Alter 14 - 21 Tage
.Range("B25").Value = alngCnt(3) ' Alter 22 - 60 Tage
.Range("B26").Value = alngCnt(0) ' Alter > 60 Tage
End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der wesentliche Unterschied liegt darin, daß die CheckDate2() Funktion gleich einen Index zurückgibt, der hier geschickt dazu verwendet wird, einen Zähler für die Bereiche mit einem Array aufzubauen und die Treffer damit aufzusummieren. Da die Rückgabewerte der CheckDate2() Funktion im Bereich von -1 ... 2 liegen können, wird der Rückgabewert mit +1 an die Array-Dimension angepaßt und direkt als Index verwendet.

Die Routine wird damit nochmal viel "aufgeräumter".

Gruß Ulrich

florianb · 23. Oktober 2020

Ah, ok. Vielen Dank für eure Hilfe.

Office: Differenz zwischen 2 Datum berechnen

Differenz zwischen 2 Datum berechnen

Differenz zwischen 2 Datum berechnen

Differenz zwischen 2 Datum berechnen

Differenz zwischen 2 Datum berechnen - Similar Threads - Differenz Datum berechnen

Wenn der Wert größer ist als 10 will ich die Differenz in einer Spalte haben

Differenz zwischen Daten - Anzeige in Tage/Stunden/Minuten

Differenz zwischen zwei Uhrzeiten mit Sekunden angabe

Pivot Planzahlen mit Pivot Istzahlen in neuer Pivot vergleichen

Kunden Bestell-Intervall

Datum: Differenz zweier Daten (ohne Wochenenden)

Differenz zwischen Datum A und Datum B in Tage bzw Monate