如何提取Excel文本单元格中的日期并移至其他列且递增月份

问题解决思路 #

用正则精准定位mm/dd格式的日期，处理月份递增的边界情况（比如12月转次年1月），同时避免无日期单元格触发错误。

可运行的VBA代码 #

Sub ExtractAndIncrementDate()
    Dim ws As Worksheet
    Dim c As Range
    Dim regEx As Object
    Dim matchResult As Object
    Dim monthNum As Integer, dayNum As Integer
    Dim targetYear As Integer
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Sheets("Sheet2")
    ' 初始化正则表达式，匹配mm/dd格式
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "\b\d{2}/\d{2}\b"
    regEx.Global = False
    ' 这里用当前年份，你也可以改成固定值比如2024
    targetYear = Year(Date)
    
    ' 遍历C列非空单元格
    For Each c In ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
        If c.Value <> "" Then
            Set matchResult = regEx.Execute(c.Value)
            ' 检查是否匹配到日期
            If matchResult.Count > 0 Then
                ' 拆分月份和日期
                monthNum = CInt(Split(matchResult(0).Value, "/")(0))
                dayNum = CInt(Split(matchResult(0).Value, "/")(1))
                
                ' 处理月份递增，跨年的情况
                If monthNum = 12 Then
                    c.Offset(0, 1).Value = DateSerial(targetYear + 1, 1, dayNum)
                Else
                    c.Offset(0, 1).Value = DateSerial(targetYear, monthNum + 1, dayNum)
                End If
                ' 设置单元格显示格式为mm/dd
                c.Offset(0, 1).NumberFormat = "mm/dd"
            Else
                ' 无日期的单元格留空
                c.Offset(0, 1).Value = ""
            End If
        End If
    Next c
    
    ' 释放对象
    Set regEx = Nothing
    Set ws = Nothing
    MsgBox "处理完成"
End Sub

代码要点说明 #

• 正则匹配：\b\d{2}/\d{2}\b确保只提取独立的mm/dd格式内容，不会误抓其他带斜杠的数字
• 错误规避：加入空值判断和匹配结果计数检查，解决之前的下标越界问题
• 边界处理：针对12月的情况，自动切换到次年1月，保证日期逻辑正确
• 格式控制：强制目标单元格用mm/dd格式显示，避免Excel自动转成其他日期格式

额外提示 #

如果你的文本里可能有多个mm/dd日期，把regEx.Global = False改成True，然后循环matchResult里的每一项即可。

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