请求改造Excel宏以兼容法语月份缩写的日期格式转换

核心问题 #

现有宏仅支持英文月份缩写（如JUL、FEB）的日期转换，无法识别带重音的法语月份缩写（如FÉV、AOÛ），需从日期转换逻辑和正则匹配规则两部分修改。

1. 重构日期转换函数convert_date #

用字典存储英文+法语的月份映射，替代原有的字符串查找，更高效且易维护，同时处理大小写和特殊字符问题：

Function convert_date(date_as_string As String) As Date
    Dim monthMap As Object
    Set monthMap = CreateObject("Scripting.Dictionary")
    
    ' 配置英文+法语月份缩写与数字的映射
    With monthMap
        .Add "JAN", 1
        .Add "FÉV", 2
        .Add "FEB", 2
        .Add "MAR", 3
        .Add "AVR", 4
        .Add "APR", 4
        .Add "MAI", 5
        .Add "MAY", 5
        .Add "JUN", 6
        .Add "JLT", 7
        .Add "JUL", 7
        .Add "AOÛ", 8
        .Add "AUG", 8
        .Add "SEP", 9
        .Add "OCT", 10
        .Add "NOV", 11
        .Add "DÉC", 12
        .Add "DEC", 12
    End With
    
    Dim monthAbbr As String
    monthAbbr = UCase(Left(date_as_string, 3)) ' 统一转大写，避免大小写敏感
    
    If monthMap.Exists(monthAbbr) Then
        convert_date = DateSerial( _
            CInt(Right(date_as_string, 4)), _
            monthMap(monthAbbr), _
            CInt(Replace(Mid(date_as_string, 4, 2), "/", "")) _
        )
    Else
        ' 无法识别月份时返回Excel错误值，便于排查
        convert_date = CVErr(xlErrValue)
    End If
End Function

2. 调整正则表达式匹配规则 #

原正则[a-zA-Z]无法匹配法语重音字符，替换为\p{L}（匹配任意Unicode字母），确保能提取含法语月份的日期：
修改test子过程中的正则：

' 原代码
.Pattern = "[a-zA-Z0-9]{7}\s\s[^\s]+\s[a-zA-Z\s]*[0-9]{2}\/[0-9]{4}"

' 修改后
.Pattern = "[\p{L}0-9]{7}\s\s[^\s]+\s[\p{L}\s]*[0-9]{2}\/[0-9]{4}"

完整修改后的代码 #

Sub test()
    Dim fn As String, mtch As Object, m As Object, s As Object, txt As String
    Dim i As Long, b As Long
    
    fn = "C:\temp\test.txt"
    
    txt = CreateObject("scripting.filesystemobject").OpenTextFile(fn).ReadAll
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "[^\n]+"
        Set mtch = .Execute(txt)
        
        i = 1
        b = 1
        For Each m In mtch
            ' 适配法语带重音字母的正则规则
            .Pattern = "[\p{L}0-9]{7}\s\s[^\s]+\s[\p{L}\s]*[0-9]{2}\/[0-9]{4}"
            
            For Each s In .Execute(m.Value)
                i = i + 1
                Cells(i, 1) = s
                b = b + 1
                Range("B" & b).Value = Right(Cells(i, 1), 10)
            Next
        Next
    End With
    
    Dim var As String
    Dim N As Long, p As Long
    N = Cells(Rows.Count, "B").End(xlUp).Row
    
    For p = 2 To N
        var = Range("B" & p).Value
        Range("C" & p).Value = convert_date(var)
        Range("D" & p).Value = Range("C" & p) + 179
        Range("E" & p).Value = Range("C" & p) + 209
    Next p
End Sub

Function convert_date(date_as_string As String) As Date
    Dim monthMap As Object
    Set monthMap = CreateObject("Scripting.Dictionary")
    
    ' 英文+法语月份缩写映射
    With monthMap
        .Add "JAN", 1
        .Add "FÉV", 2
        .Add "FEB", 2
        .Add "MAR", 3
        .Add "AVR", 4
        .Add "APR", 4
        .Add "MAI", 5
        .Add "MAY", 5
        .Add "JUN", 6
        .Add "JLT", 7
        .Add "JUL", 7
        .Add "AOÛ", 8
        .Add "AUG", 8
        .Add "SEP", 9
        .Add "OCT", 10
        .Add "NOV", 11
        .Add "DÉC", 12
        .Add "DEC", 12
    End With
    
    Dim monthAbbr As String
    monthAbbr = UCase(Left(date_as_string, 3))
    
    If monthMap.Exists(monthAbbr) Then
        convert_date = DateSerial( _
            CInt(Right(date_as_string, 4)), _
            monthMap(monthAbbr), _
            CInt(Replace(Mid(date_as_string, 4, 2), "/", "")) _
        )
    Else
        convert_date = CVErr(xlErrValue)
    End If
End Function

Sub testConvertDate()
    Dim var As String
    Dim N As Long, i As Long
    N = Cells(Rows.Count, "B").End(xlUp).Row
    
    For i = 2 To N
        var = Range("B" & i).Value
        Range("C" & i).Value = convert_date(var)
        Range("D" & i).Value = Range("C" & i) + 179
        Range("E" & i).Value = Range("C" & i) + 209
    Next i
End Sub

优化亮点 #

• 字典映射：比原字符串查找效率更高，新增/修改月份只需调整字典项
• 正则兼容：支持带重音的法语字母，不会漏匹配日期
• 大小写容错：统一转大写处理，避免输入大小写不一致导致的识别失败
• 错误处理：无法识别的月份返回Excel错误值，方便定位问题

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