Excel宏日期映射问题：1004错误与日期格式异常求助

问题概述 #

需实现Excel跨文件数据映射功能：

• 用户在目标文件输入日期（格式如12jun23）
• 将输入日期转换为12-Jun-23格式
• 在源文件W列搜索该日期，找到后将指定列数据映射到目标文件

运行时遇到两个问题：

1. 触发1004「应用程序或对象定义错误」
2. 输入30may23时，日期被错误转换为30-Dec-99

修正后的完整代码 #

Sub UpdateData()
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet
    Dim sourceRow As Long
    Dim targetRow As Long
    Dim targetDate As Date
    Dim targetDateStr As String
    Dim dayPart As String, monthPart As String, yearPart As String
    Dim searchRange As Range, foundCell As Range
    
    ' 初始化目标行：取目标工作表最后一行的下一行（追加数据）
    Set wbTarget = ThisWorkbook
    Set wsTarget = wbTarget.Sheets("Released")
    targetRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 提示用户输入日期
    targetDateStr = Application.InputBox("Enter the date (DDMMMYY)", Type:=2)
    If targetDateStr = "" Then Exit Sub ' 用户取消输入时退出
    
    ' 手动拆分输入的日期字符串（处理ddmmmYY格式）
    If Len(targetDateStr) = 6 Then
        dayPart = Left(targetDateStr, 2)
        monthPart = Mid(targetDateStr, 3, 3)
        yearPart = Right(targetDateStr, 2)
        ' 构造有效日期：年份自动补全为20xx
        On Error Resume Next
        targetDate = DateValue(dayPart & "-" & monthPart & "-20" & yearPart)
        On Error GoTo 0
    End If
    
    ' 检查目标日期是否有效
    If Not IsDate(targetDate) Then
        MsgBox "Invalid date entered. Please use DDMMMYY format (e.g. 12jun23)."
        Exit Sub
    End If
    
    ' 打开源文件并设置工作表（添加错误捕获）
    On Error Resume Next
    Set wbSource = Workbooks.Open("C:\Users\E12\Desktop\FY23.xlsx")
    On Error GoTo 0
    If wbSource Is Nothing Then
        MsgBox "Failed to open source file. Check file path and permissions."
        Exit Sub
    End If
    Set wsSource = wbSource.Sheets("Pull in")
    If wsSource Is Nothing Then
        MsgBox "Source worksheet 'Pull in' not found."
        wbSource.Close SaveChanges:=False
        Exit Sub
    End If
    
    ' 在源文件W列查找目标日期（使用Find方法，兼容日期/文本格式）
    Set searchRange = wsSource.Columns("W")
    Set foundCell = searchRange.Find(What:=targetDate, LookIn:=xlValues, LookAt:=xlWhole)
    
    ' 找到匹配项则更新数据
    If Not foundCell Is Nothing Then
        sourceRow = foundCell.Row
        ' 源列到目标列的映射
        wsTarget.Cells(targetRow, 1).Value = wsSource.Cells(sourceRow, 2).Value
        wsTarget.Cells(targetRow, 2).Value = wsSource.Cells(sourceRow, 4).Value
        wsTarget.Cells(targetRow, 3).Value = wsSource.Cells(sourceRow, 5).Value
        wsTarget.Cells(targetRow, 4).Value = wsSource.Cells(sourceRow, 6).Value
        wsTarget.Cells(targetRow, 5).Value = wsSource.Cells(sourceRow, 7).Value
        wsTarget.Cells(targetRow, 6).Value = wsSource.Cells(sourceRow, 8).Value
        wsTarget.Cells(targetRow, 7).Value = wsSource.Cells(sourceRow, 9).Value
        wsTarget.Cells(targetRow, 8).Value = wsSource.Cells(sourceRow, 12).Value
        wsTarget.Cells(targetRow, 9).Value = wsSource.Cells(sourceRow, 13).Value
        wsTarget.Cells(targetRow, 10).Value = wsSource.Cells(sourceRow, 16).Value
        wsTarget.Cells(targetRow, 11).Value = wsSource.Cells(sourceRow, 18).Value
        wsTarget.Cells(targetRow, 12).Value = wsSource.Cells(sourceRow, 21).Value
        wsTarget.Cells(targetRow, 13).Value = wsSource.Cells(sourceRow, 23).Value
        wsTarget.Cells(targetRow, 14).Value = wsSource.Cells(sourceRow, 1).Value
        
        MsgBox "Data updated successfully."
    Else
        MsgBox "No data found for the specified date."
    End If
    
    ' 关闭源文件
    wbSource.Close SaveChanges:=False
End Sub

错误修复细节 #

1. 解决1004错误 #

• 未初始化targetRow：原代码中targetRow默认值为0，Excel行号从1开始，写入Cells(0,1)会触发错误。修正后取目标表最后一行的下一行（追加数据），也可根据需求改为指定行号。
• 文件/工作表不存在：添加错误捕获，检查源文件和工作表是否成功打开，避免因路径错误或工作表不存在触发错误。
• 匹配方式问题：原Match函数对单元格格式敏感（如源列是文本格式日期则匹配失败），改用Find方法，兼容日期和文本格式的单元格。

2. 解决日期转换错误 #

• DateValue无法识别无分隔符格式：输入的30may23是无分隔符的ddmmmYY格式，DateValue无法正确解析，导致错误转换为30-Dec-99。修正后手动拆分日、月、年部分，拼接为dd-mmm-20YY格式后再转换为日期，确保年份补全为20xx（如23→2023）。

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