求助调整VBA复制宏：仅复制符合指定日期条件的数据

嘿，十年没碰VBA确实容易有点手生，咱们一步步把这个逻辑捋顺！

核心思路拆解 #

你需要完成这几个关键步骤：

• 弹出输入框让用户指定目标日期
• 遍历源工作表的E列数据，逐一判断日期是否匹配
• 匹配时将对应A列的数据复制到目标工作表的第一个空白单元格

完整示例代码 #

Sub CopyMatchingDateData()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim inputDate As Date
    Dim lastRow As Long
    Dim i As Long
    Dim targetLastRow As Long
    
    ' 设置源表和目标表（根据你的实际表名修改）
    Set sourceSheet = ThisWorkbook.Worksheets("源工作表")
    Set targetSheet = ThisWorkbook.Worksheets("目标工作表")
    
    ' 获取用户输入的日期，做简单的格式校验
    On Error Resume Next
    inputDate = InputBox("请输入要匹配的日期（格式：YYYY/MM/DD）", "指定日期")
    On Error GoTo 0
    If IsEmpty(inputDate) Then Exit Sub ' 用户取消输入则退出
    
    ' 找到源表E列的最后一行数据
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "E").End(xlUp).Row
    
    ' 遍历源表每一行（假设第1行是表头，从第2行开始）
    For i = 2 To lastRow
        ' 判断E列日期是否和输入日期相等（统一格式避免匹配失败）
        If CDate(sourceSheet.Cells(i, "E").Value) = inputDate Then
            ' 找到目标表A列的最后一个空白行
            targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
            ' 复制源表A列数据到目标表
            targetSheet.Cells(targetLastRow, "A").Value = sourceSheet.Cells(i, "A").Value
            ' 如果需要同步复制其他列，比如B/C/D，可添加类似语句
            ' targetSheet.Cells(targetLastRow, "B").Value = sourceSheet.Cells(i, "B").Value
        End If
    Next i
    
    MsgBox "匹配数据复制完成！", vbInformation
End Sub

关键逻辑说明 #

1. 日期匹配的避坑点：
   • 用CDate()函数统一转换格式，避免源表E列是文本格式导致匹配失效
   • 确保用户输入的日期格式和系统日期格式兼容，InputBox会自动识别常规日期格式
2. 空白行定位：
   • End(xlUp).Row + 1是VBA找最后空白行的标准写法，不会覆盖目标表已有的数据
3. 容错处理：
   • 加入了输入校验，防止用户输入无效日期或取消操作时宏报错

调试小技巧 #

• 可以在If语句里加Debug.Print "匹配行：" & i，然后按Ctrl+G打开「立即窗口」，查看哪些行被命中，方便排查逻辑问题
• 暂停宏执行，查看sourceSheet.Cells(i, "E").Value和inputDate的实际值，确认两者格式是否一致

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