VBA中使用DateAdd为字符串格式日期加月时出现类型不匹配错误

问题场景 #

需要为日期添加一个月，单独使用DateAdd函数硬编码日期字符串（比如"31.01.2023"）时可以正常运行，但在For循环中从单元格读取dd.mm.yyyy格式的字符串日期传入时，会触发类型不匹配错误。

简化后的报错代码：

stringMonth = ActiveSheet.range("K" & ErsteLeereZeile - 1).Value
dateMonth   = DateAdd("M", 1, CDate(stringMonth))

完整的VBA代码：

Public Function copyWiederkehrend(all As Variant)
    
    Dim month As String
    Dim datePay As Date
    Dim i, j As Integer
    Dim ErsteLeereZeile As Long
    
    'loop throw all rows that i have passed
    For i = 1 To all.Rows.Count
        
        'looking for the first emtpy row
        ErsteLeereZeile = Worksheets("Zusammenzug").Cells(Rows.Count, 1).End(xlUp).row + 1
        'shows the hidden column copy the row and remove the column it again
        Columns("C:C").EntireColumn.Hidden = False
        range("B" & all(i).row & ":L" & all(i).row).Copy
        Columns("C:C").EntireColumn.Hidden = True
        With ThisWorkbook.Worksheets("Zusammenzug")
            'add the first row
            .Cells(ErsteLeereZeile, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            'copy the added row and add it 17 times again and add one month
            For j = 1 To 17
                ErsteLeereZeile = Worksheets("Zusammenzug").Cells(Rows.Count, 1).End(xlUp).row + 1
                .Cells(ErsteLeereZeile, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                month = .range("K" & ErsteLeereZeile - 1).Value
                datePay = DateAdd("m", 1, month)
                .range("K" & ErsteLeereZeile).Value = datePay
            Next j
        End With
    Next i
End Function

原因分析 #

1. 区域设置兼容性问题：CDate和DateAdd对日期字符串的解析依赖系统区域设置。如果系统区域的日期分隔符不是.，或默认日期格式不是dd.mm.yyyy，直接转换会失败，触发类型不匹配。
2. 单元格值的隐性问题：即使单元格显示为dd.mm.yyyy，可能存在隐形空格、非标准字符，或是被格式化为文本的日期值，导致转换函数无法识别。

解决方法 #

方法1：手动解析日期字符串（不依赖区域设置） #

拆分dd.mm.yyyy格式的字符串，提取日、月、年，用DateSerial生成标准日期后再调用DateAdd：

Dim dateParts() As String
Dim originalDate As Date
Dim stringMonth As String

stringMonth = ActiveSheet.Range("K" & ErsteLeereZeile - 1).Value
' 去除空格并按小数点拆分
dateParts = Split(Trim(stringMonth), ".")
' 生成标准日期：DateSerial(年, 月, 日)
originalDate = DateSerial(CInt(dateParts(2)), CInt(dateParts(1)), CInt(dateParts(0)))
' 添加一个月
dateMonth = DateAdd("m", 1, originalDate)

方法2：强制转换为兼容格式 #

将dd.mm.yyyy转换为系统区域支持的日期格式（比如mm/dd/yyyy或dd/mm/yyyy），再进行转换：

Dim stringMonth As String
Dim formattedDate As String
Dim dateMonth As Date

stringMonth = ActiveSheet.Range("K" & ErsteLeereZeile - 1).Value
' 将点分隔替换为斜杠，调整为系统兼容的格式（示例为mm/dd/yyyy）
formattedDate = Mid(stringMonth, 4, 2) & "/" & Left(stringMonth, 2) & "/" & Right(stringMonth, 4)
dateMonth = DateAdd("m", 1, CDate(formattedDate))

方法3：优化原循环逻辑（减少粘贴操作） #

原代码频繁粘贴可能导致单元格值异常，可先获取原始日期，再循环生成后续日期：

Public Function copyWiederkehrend(all As Variant)
    
    Dim originalDate As Date
    Dim datePay As Date
    Dim i, j As Integer
    Dim ErsteLeereZeile As Long
    Dim sourceRow As Range
    Dim dateParts() As String
    
    For i = 1 To all.Rows.Count
        Set sourceRow = all.Rows(i)
        ErsteLeereZeile = Worksheets("Zusammenzug").Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        ' 处理隐藏列并复制行
        Columns("C:C").EntireColumn.Hidden = False
        sourceRow.Range("B:L").Copy
        Columns("C:C").EntireColumn.Hidden = True
        
        With ThisWorkbook.Worksheets("Zusammenzug")
            ' 粘贴第一行
            .Cells(ErsteLeereZeile, 1).PasteSpecial Paste:=xlPasteValues
            ' 解析原始日期
            dateParts = Split(Trim(sourceRow.Range("K").Value), ".")
            originalDate = DateSerial(CInt(dateParts(2)), CInt(dateParts(1)), CInt(dateParts(0)))
            
            ' 循环生成17次新增行
            For j = 1 To 17
                ErsteLeereZeile = ErsteLeereZeile + 1
                ' 复制上一行值
                .Rows(ErsteLeereZeile - 1).Copy
                .Cells(ErsteLeereZeile, 1).PasteSpecial Paste:=xlPasteValues
                ' 设置新增后的日期
                datePay = DateAdd("m", j, originalDate)
                .Range("K" & ErsteLeereZeile).Value = datePay
            Next j
        End With
    Next i
End Function

验证要点 #

• 用Trim()函数去除日期字符串前后的隐形空格。
• 如果系统区域默认日期格式是dd/mm/yyyy，直接替换分隔符为/即可，无需调整日和月的位置。

内容的提问来源于stack exchange，提问作者Nötter