Excel VBA技术求助：Sheet1与Sheet2日期匹配及数据粘贴问题

嘿，Dave！我完全懂你现在的焦虑——卡在收尾环节两周，还要跟陈旧系统的手动录入较劲，换谁都急。咱们直接上干货，把这个日期匹配+数据粘贴的问题搞定：

先对齐核心场景（你可以按需调整） #

默认你的场景是：

• Sheet1中合并后的日期单元格是A1（如果不是，改代码里的对应位置就行）
• Sheet2的30列日期在第1行（表头行，从A1到AD1）
• 你要从Sheet1复制的数据区域是B2:C10（按需修改数据范围）

直接能用的VBA代码 #

打开Excel按Alt+F11打开VBA编辑器，插入新模块，粘贴以下代码：

Sub MatchDateAndPasteData()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim targetDate As Date
    Dim dateColumn As Integer
    Dim pasteRow As Long
    Dim sourceDataRange As Range
    Dim targetDateCell As Range
    
    ' 绑定工作表（表名不对的话直接改这里）
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    
    ' 定义Sheet1的目标日期单元格和待复制数据区域
    Set targetDateCell = ws1.Range("A1") ' 改成你实际的合并单元格地址
    Set sourceDataRange = ws1.Range("B2:C10") ' 改成你要复制的数据范围
    
    ' 统一日期格式，避免格式不匹配导致匹配失败
    On Error Resume Next
    targetDate = DateValue(targetDateCell.Value)
    If Err.Number <> 0 Then
        MsgBox "Sheet1的日期格式不对，请检查！", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    ' 遍历Sheet2的30列日期找匹配
    dateColumn = 0
    For i = 1 To 30
        If IsDate(ws2.Cells(1, i).Value) Then
            If DateValue(ws2.Cells(1, i).Value) = targetDate Then
                dateColumn = i
                Exit For
            End If
        End If
    Next i
    
    ' 检查是否找到匹配日期
    If dateColumn = 0 Then
        MsgBox "Sheet2里没找到匹配的日期！", vbInformation
        Exit Sub
    End If
    
    ' 找到该日期列下方的第一个空行
    pasteRow = ws2.Cells(ws2.Rows.Count, dateColumn).End(xlUp).Row + 1
    
    ' 粘贴数据（这里用值粘贴避免格式冲突；要带格式就改成sourceDataRange.Copy ws2.Cells(pasteRow, dateColumn)）
    sourceDataRange.Copy
    ws2.Cells(pasteRow, dateColumn).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False ' 清除复制状态
    
    MsgBox "数据已成功粘贴到Sheet2对应日期下方！", vbInformation
End Sub

关键调整提示 #

• 日期单元格不是A1？直接修改Set targetDateCell = ws1.Range("A1")里的地址
• 数据范围不对？改Set sourceDataRange = ws1.Range("B2:C10")即可
• Sheet2日期不在第1行？把ws2.Cells(1, i)里的1改成实际表头行号
• 要粘贴格式/公式？把Paste:=xlPasteValues换成xlPasteAll或xlPasteFormulas

避坑提醒 #

• 日期格式不统一是头号坑！代码里用DateValue()统一转格式，避免“2024/05/20”和“2024-05-20”不匹配
• 如果Sheet2的日期是文本格式，先选中这些单元格用「数据-分列」转成日期格式，不然匹配会失效

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