求助：Excel VBA中IsDate函数适配不同本地日期格式的解决方案

针对不同系统日期格式用户运行VBA代码时IsDate函数识别失败的问题，有两种优雅的修复思路，核心是摆脱对系统区域设置的依赖：

1. 自定义日期格式校验函数 #

直接针对导入数据的dd.mm.yyyy格式做解析，完全不依赖系统区域。示例代码如下：

Function IsDateDMY(inputStr As String) As Boolean
    Dim parts() As String
    Dim dayVal As Integer, monthVal As Integer, yearVal As Integer
    
    ' 按点分割字符串
    parts = Split(inputStr, ".")
    If UBound(parts) <> 2 Then ' 不是三个部分直接返回False
        IsDateDMY = False
        Exit Function
    End If
    
    ' 转换为数值并检查合法性
    On Error Resume Next
    dayVal = CInt(parts(0))
    monthVal = CInt(parts(1))
    yearVal = CInt(parts(2))
    On Error GoTo 0
    
    ' 验证日、月、年的范围
    If dayVal >= 1 And dayVal <= 31 Then
        If monthVal >= 1 And monthVal <= 12 Then
            If yearVal >= 1900 And yearVal <= 9999 Then ' Excel支持的年份范围
                ' 额外处理小月和闰年的2月
                Select Case monthVal
                    Case 4, 6, 9, 11
                        If dayVal <= 30 Then IsDateDMY = True
                    Case 2
                        If (yearVal Mod 4 = 0 And yearVal Mod 100 <> 0) Or (yearVal Mod 400 = 0) Then
                            IsDateDMY = (dayVal <= 29)
                        Else
                            IsDateDMY = (dayVal <= 28)
                        End If
                    Case Else
                        IsDateDMY = True
                End Select
            End If
        End If
    End If
End Function

把原代码中的IsDate(Sheets(sSheet).Range("C" & i).Value)替换成IsDateDMY(Sheets(sSheet).Range("C" & i).Value)即可。这个方法最稳妥，完全不受用户系统设置影响。

2. 临时切换系统区域设置（不推荐） #

如果一定要用原生IsDate，可以临时把系统的短日期格式改成dd.MM.yyyy，校验完成后再恢复。但这个方法需要用户有修改系统设置的权限，而且可能影响其他程序，示例代码如下：

Sub TempChangeDateFormat()
    Dim originalFormat As String
    ' 获取当前系统短日期格式
    originalFormat = CreateObject("WScript.Shell").RegRead("HKCU\Control Panel\International\sShortDate")
    
    ' 设置为目标格式
    CreateObject("WScript.Shell").RegWrite "HKCU\Control Panel\International\sShortDate", "dd.MM.yyyy"
    
    ' 执行你的原有循环逻辑
    Dim i As Integer, sSheet As String
    sSheet = "你的工作表名"
    i = 1 ' 假设从第一行开始
    While IsDate(Sheets(sSheet).Range("C" & i).Value) = True
        Sheets(sSheet).Range("A" & i).Value = Variable1
        Sheets(sSheet).Range("B" & i).Value = Variable2
        i = i + 1
    Wend
    
    ' 恢复原日期格式
    CreateObject("WScript.Shell").RegWrite "HKCU\Control Panel\International\sShortDate", originalFormat
End Sub

优先推荐第一种自定义函数的方案，既安全又不依赖系统环境。

内容的提问来源于stack exchange，提问作者Handy93