Excel - Datumsfunktion

jerry0110

Erfahrenes Mitglied
Hi,

ich habe für meine Speicherung folgendes vor. Ich möchte gerne das die Dateien immer mit dem Tag vorher abgespeichert werden. Dies Funktion habe ich erstellt um das Datum so anzupassen,wenn es Montag ist, dass man die Datei zu mit dem Datum von Freitag abspeichert. Ist es Dienstag dann der Montag.

Funktion:

Code:
Private Function Datum()

Dim myDate As Date

If Date = Weekday(Date, vbMonday) Then

    myDate = Date - 3
  
  Else
  
    myDate = Date - 1
  
End If
End Function

Speicherung:

Code:
Private Sub Datei_speichern_Buchhaltung()

Dim sOrdner As String
Dim sblattname As String
Dim sFilename As String
Dim myDate As Date
myDate = Datum

sOrdner = "C:\test\"
sblattname = Format(myDate, "YYYYMMDD") & "_Buchhaltung.xls"

sFilename = Application.GetSaveAsFilename _
(sOrdner & sblattname, "Micrsoft Excel-Dateien (*.xls),*.xls")

Worksheets("Buchhaltung").Activate
ActiveSheet.Copy
ActiveWorkbook.SaveAs sFilename, FileFormat:=xlNormal
ActiveWorkbook.Close False

End Sub

Wo habe ich den Denkfehler?
 

Yaslaw

n/a
Moderator
Visual Basic:
If Date = Weekday(Date, vbMonday) Then
'ersetzen durch
If WeekDay(date, vbMonday) = 1 Then

Nachtrag: Bie der Funktion datum() hast du kein Rücgabewert.
Ich würde die ganze Funktion so umschreiben
Visual Basic:
Private Function datum() As Date
    If Weekday(Date, vbMonday) = 1 Then
        datum = Date - 3     
    Else
        datum = Date - 1     
    End If
End Function

Oder die ganze Funktion gleich weglassen und in der Haubtroutine lösen
Visual Basic:
..
Dim myDate As Date
myDate = Date - Iif( Weekday(Date, vbMonday) = 1, 3, 1)
 
sOrdner = "C:\test\"
..
 
Zuletzt bearbeitet:

jerry0110

Erfahrenes Mitglied
Wie dämlich von mir. Klar muss der Rückgabewert drin sind.
Habe aber jetzt das als Funktion genommen, weil ich die noch bei mehreren Stellen benutzten kann.
 

Yaslaw

n/a
Moderator
Ich würde aber die Funktion noch erweitern, damit due auch den Fall abfängst, wenn jemand am Samstag oder Sonntag etwas erfasst.

Mit ien Wenig tricksen beim Wochenanfang, kann man relativ einfach die Differenz zum Freitag ermitteln
Visual Basic:
Public Function lastWorkDay(Optional ByVal iDate) As Date
  If IsMissing(iDate) Then iDate = Date
  lastWorkDay = iDate - IIf(weekDay(iDate, vbSaturday) <= 3, weekDay(iDate, vbSaturday), 1)
End Function

Eine Testreihe dazu
Visual Basic:
'Dienstag -> Montag
?lastWorkDay(#03/22/2016#)
21.03.2016

'Montag -> Freitag
?lastWorkDay(#03/21/2016#)
18.03.2016

'Sonntag -> Freitag
?lastWorkDay(#03/20/2016#)
18.03.2016

'Samstag -> Freitag
?lastWorkDay(#03/19/2016#)
18.03.2016

'Freitag -> Donnerstag
?lastWorkDay(#03/18/2016#)
17.03.2016