简体   繁体   中英

Unexpected Date Results - Excel VBA - Day Month Year get mixed up

I have two date ranges that I am trying to turn into two strings OldestDate and NewestDate . But, today I came across and issue where one date was formatted dd/mm/yyyy and the other mm/dd/yyyy

Here is example data that I placed on two separate worksheets: Note, I copied the cells contents next to the "date" formatted cell for visual reference, but in my actual data, there is only the "date" column.

在此处输入图片说明

and

在此处输入图片说明

Here is the code I use to transform into string and the debug output:

Public Sub Get_Date()
 
DateHeader = "A"

Set rng = Application.ActiveSheet.Range(DateHeader & "1:" & DateHeader & Cells(Rows.Count, 1).End(xlUp).Offset(1).Row)

OldestDate = Format(WorksheetFunction.min(rng), "dd/mm/yyyy")
Debug.Print OldestDate

NewestDate = Format(WorksheetFunction.Max(rng), "dd/mm/yyyy")
Debug.Print NewestDate

'20200908
'Sept 8, 2020

aDate = Split(OldestDate, "/")
If UBound(aDate) = 2 Then
 sDay = aDate(0)
 If Len(sDay) = 1 Then
  sDay = "0" & sDay
 End If
 sMonth = aDate(1)
 If Len(sMonth) = 1 Then
  sMonth = "0" & sMonth
 End If
 sYear = aDate(2)
End If
OldestDateStr = sYear & sMonth & sDay
Debug.Print OldestDateStr

aDate = Split(NewestDate, "/")
If UBound(aDate) = 2 Then
 sDay = aDate(0)
 If Len(sDay) = 1 Then
  sDay = "0" & sDay
 End If
 sMonth = aDate(1)
 If Len(sMonth) = 1 Then
  sMonth = "0" & sMonth
 End If
 sYear = aDate(2)
End If
NewestDateStr = sYear & sMonth & sDay
Debug.Print NewestDateStr

End Sub

Console/Debug:

7/10/2020 ' This is Correct
8/10/2020 ' This is Correct
20201007  ' This is Correct
20201008  ' This is Correct
8/17/2020 ' Incorrect
8/18/2020 ' Incorrect
20201708  ' Incorrect
20201808  ' Incorrect

I took a workaround approach vs debugging to much and just scraped the month/year and then hard coded 1 for first day and used the function EoMonth to get the last day. This was being used to create a URL to query based on dates, the query will take a tiny bit longer and have extra data, but thats OK w/ me, I'd rather have reliability 100%.

here is the new code, which is also less complicated to read :)

Public Sub Get_Date()
 
DateHeader = "A"

Set rng = Application.ActiveSheet.Range(DateHeader & "1:" & DateHeader & Cells(Rows.Count, 1).End(xlUp).Offset(1).Row)

Dim OldestDate As Date, NewestDate As Date

OldestDate = Format(WorksheetFunction.min(rng), "mm/yyyy")
Debug.Print OldestDate
NewestDate = Format(WorksheetFunction.Max(rng), "mm/yyyy")
Debug.Print NewestDate

'20200908
'Sept 8, 2020

'OldestDate
aDate = Split(OldestDate, "/")
sYear = aDate(2)
sMonth = aDate(0)
If Len(sMonth) = 1 Then
 sMonth = "0" & sMonth
End If
sDay = "01"
OldestDateStr = sYear & sMonth & sDay
Debug.Print OldestDateStr

'NewestDate
aDate = Split(NewestDate, "/")
sYear = aDate(2)
sMonth = aDate(0)
If Len(sMonth) = 1 Then
 sMonth = "0" & sMonth
End If
sDay = Day(Application.WorksheetFunction.EoMonth(NewestDate , 0))
NewestDateStr = sYear & sMonth & sDay
Debug.Print NewestDateStr

End Sub

Debug: (Note I changed one date to Nov just for testing)

10/1/2020 
11/1/2020 
20201001
20201130
8/1/2020 
8/1/2020 
20200801
20200830

Format will do this in one go:

OldestDateStr = Format(WorksheetFunction.min(rng), "yyyymmdd")
Debug.Print OldestDateStr

NewestDateStr = Format(WorksheetFunction.Max(rng), "yyyymmdd")
Debug.Print NewestDateStr

If your cell values are text dates formatted as the "reversed" US format mm/dd/yyyy , and you are not in a US environment, you can use this function to convert these to true date values:

' Converts a US formatted date/time string to a date value.
'
' Examples:
'   7/6/2016 7:00 PM    -> 2016-07-06 19:00:00
'   7/6 7:00 PM         -> 2018-07-06 19:00:00  ' Current year is 2018.
'   7/6/46 7:00 PM      -> 1946-07-06 19:00:00
'   8/9-1982 9:33       -> 1982-08-09 09:33:00
'   2/29 14:21:56       -> 2039-02-01 14:21:56  ' Month/year.
'   2/39 14:21:56       -> 1939-02-01 14:21:56  ' Month/year.
'   7/6/46 7            -> 1946-07-06 00:00:00  ' Cannot read time.
'   7:32                -> 1899-12-30 07:32:00  ' Time value only.
'   7:32 PM             -> 1899-12-30 19:32:00  ' Time value only.
'   7.32 PM             -> 1899-12-30 19:32:00  ' Time value only.
'   14:21:56            -> 1899-12-30 14:21:56  ' Time value only.
'
' 2018-03-31. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function CDateUs( _
    ByVal Expression As String) _
    As Date
    
    Const PartSeparator As String = " "
    Const DateSeparator As String = "/"
    Const DashSeparator As String = "-"
    Const MaxPartCount  As Integer = 2

    Dim Parts           As Variant
    Dim DateParts       As Variant
    
    Dim DatePart        As Date
    Dim TimePart        As Date
    Dim Result          As Date
    
    ' Split expression into maximum two parts.
    Parts = Split(Expression, PartSeparator, MaxPartCount)
    
    
    If IsDate(Parts(0)) Then
        ' A date or time part is found.
        ' Replace dashes with slashes.
        Parts(0) = Replace(Parts(0), DashSeparator, DateSeparator)
        If InStr(1, Parts(0), DateSeparator) > 1 Then
            ' A date part is found.
            DateParts = Split(Parts(0), DateSeparator)
            If UBound(DateParts) = 2 Then
                ' The date includes year.
                DatePart = DateSerial(DateParts(2), DateParts(0), DateParts(1))
            Else
                If IsDate(CStr(Year(Date)) & DateSeparator & Join(DateParts, DateSeparator)) Then
                    ' Use current year.
                    DatePart = DateSerial(Year(Date), DateParts(0), DateParts(1))
                Else
                    ' Expression contains month/year.
                    DatePart = CDate(Join(DateParts, DateSeparator))
                End If
            End If
            If UBound(Parts) = 1 Then
                If IsDate(Parts(1)) Then
                    ' A time part is found.
                    TimePart = CDate(Parts(1))
                End If
            End If
        Else
            ' A time part it must be.
            ' Concatenate an AM/PM part if present.
            TimePart = CDate(Join(Parts, PartSeparator))
        End If
    End If
    
    Result = DatePart + TimePart
        
    CDateUs = Result

End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM