Excel VBA：从任何操作系统区域/区域解析英文日期

Question

我有一个带有日期选择器的电子表格。日，月，年的单独细胞被选中，像这样：

然后，我有一些代码，拿起选定的日期，然后检查它是否是一个真正的日期（例如，不2月31日），然后检查它是否“大于或等于”单元格A1中的预设日期。 A1中预设日期的格式并不重要，只要它是日期格式即可。

该功能工作得很好，直到我将我的OS区域更改为例如西班牙。因为非常简单，CDate（blah）可以在英国/美国地区解析“2016年1月1日”，但在西班牙地区模式下，期望看到Enero，febrero，marzo，abril等，而不是1月，2月等。这是（Windows）中我使用的是效仿其他地区设置：步骤是

Sub getDate() 
    'pick up date: 
    theDay = Cells(13, 9).Value 
    theMonth = Cells(13, 10).Value 
    theYear = Cells(13, 11).Value 

    theCurrentDate = theDay & " " & theMonth & " " & theYear 

    'highlight bad date: 
    If Not IsDate(theCurrentDate) Then 
     Cells(13, 9).Interior.ColorIndex = 38 
     Exit Sub 
    End If 

    If CDate(theCurrentDate) >= CDate(Cells(1, 1)) Then 
     'do some stuff 
    End If 
End Sub 

“标明劣枣”：

这是我的代码片段代码在非英语区域/区域设置中会出现问题......它将突出显示日期单元格。我认为这是一种很好的方法，可以发现2月30日这样的不良日期，同时要记住所有三个单元格都是使用列表进行数据验证的。

选择日期而不是键入日期很重要，我想保持DD-Month-YYYY的可视格式，以超越文化（阅读：强制用户符合单一格式）。

我一直在努力解决如何告诉它假装程序语言环境是英国的代码...或告诉它，它的日期是在英国的语言环境...我可以'吨数字，任何建议表示赞赏。谢谢。

---

EDIT1：我找到了解决此问题的解决方法。这可以通过将月份名称转换为数字，然后使用DateSerial函数将其转换为...序列日期来实现。问题是，如果你给它一个4月31日的日期（4月有30天），那么日期序列转换将在5月1日结束。所以我不得不做一个例程，手动检查它是一个合法的日期（包括闰年）...这里是新代码，再次简化，尽管我已经包括了错误处理，但这次只是为了使它更完整）：

Sub getDate() 
    theErr = 0 
    'pick up date: 
    theDay = Cells(13, 9).Value 
    theMonth = Cells(13, 10).Value 
    theYear = Cells(13, 11).Value 

    'Convert month name to number: 
    If theMonth = "January" Then 
     theMonth = 1 
    ElseIf theMonth = "February" Then 
     theMonth = 2 
    ElseIf theMonth = "March" Then 
     theMonth = 3 
    ElseIf theMonth = "April" Then 
     theMonth = 4 
    ElseIf theMonth = "May" Then 
     theMonth = 5 
    ElseIf theMonth = "June" Then 
     theMonth = 6 
    ElseIf theMonth = "July" Then 
     theMonth = 7 
    ElseIf theMonth = "August" Then 
     theMonth = 8 
    ElseIf theMonth = "September" Then 
     theMonth = 9 
    ElseIf theMonth = "October" Then 
     theMonth = 10 
    ElseIf theMonth = "November" Then 
     theMonth = 11 
    ElseIf theMonth = "December" Then 
     theMonth = 12 
    End If 

    'Check manually for bad dates: 
    If InStr("2/4/6/9/11", CStr(theMonth)) Then 'a month with 30 or fewer days: 
     If theMonth <> 1 Then 'January ("1") is found in 11, but January is OK, it has 31 days... 
      If theDay = 31 Then 
       Cells(13, 9).Interior.ColorIndex = 38 
       theErr = theErr + 1 
      End If 
      If InStr("2", CStr(theMonth)) Then 'February, with either 28 or 29 days: 
       If theDay = 30 Then 
        Cells(13, 9).Interior.ColorIndex = 38 
        theErr = theErr + 1 
       ElseIf theDay = 29 Then 
        If theYear Mod 4 <> 0 Then 'not a leap year: 
         Cells(13, 9).Interior.ColorIndex = 38 
         theErr = theErr + 1 
        End If 
       End If 
      End If 
     End If 
    End If 

    'Give error message if date error picked up: 
    If theErr <> 0 Then 
     MsgBox "Please check your date", vbOKOnly, "getDate" 
     Exit Sub 
    End If 

    theCurrentDate = DateSerial(theYear, theMonth, theDay) 

    If CDate(theCurrentDate) >= CDate(Cells(1, 1)) Then 
     'do some stuff 
    End If 
End Sub 

这有点冗长....但它确实有效，现在OS区域不会影响它。

Answer 1

您可以关闭错误处理并将创建的字符串日期分配给日期变量。

然后您可以检查是否导致错误;如果是这样，我们知道使用的日期不是真正的日期。

这应该适用于所有地区，因为它不依赖于OS语言设置。

Sub getDate() 

    Dim checkDate As Date 

    'pick up date: 
    theDay = Cells(13, 9).Value 
    theMonth = Cells(13, 10).Value 
    theYear = Cells(13, 11).Value 

    theCurrentDate = theDay & " " & theMonth & " " & theYear 

    On Error Resume Next 
    checkDate = theCurrentDate 

    'highlight bad date: 
    If Err.Number > 0 Then 
     Cells(13, 9).Interior.ColorIndex = 38 
     Exit Sub 
    End If 

    On Error GoTo 0 

    If CDate(theCurrentDate) >= CDate(Cells(1, 1)) Then 
     'do some stuff 
    End If 
End Sub