VBA脚本执行报「类型不匹配」：跨工作表按匹配键复制数据求助

需求说明 #

使用「Raw data」工作表的数据填充「Assessment」工作表：当两表A列值匹配时，将「Raw data」的B、C、D、E、F、G、H列数据复制到「Assessment」对应列，两表行数不一致。

原报错脚本 #

Sub Populate()
    
    Dim ws_copy As Worksheet
    Dim ws_paste As Worksheet
    Dim LastRow As Long
    Dim i As Long, j As Long
    
    Call Open_Workbook
    
    
    Set ws_copy = Workbooks("Raw data.xlsx").Sheets("sheet1")
    Set ws_paste = Workbooks("Assessment.xlsx").Sheets("sheet1")
    
    With ws_copy
      
      LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
   
    End With
    
   
   
    With ws_paste
        
        j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   
    End With

   For i = 2 To LastRow
   
    With ws_copy
    
        If Application.Match(ws_copy.Range("A:A"), ws_paste.Range("A:A"), 0) <> 0 Then
            .Cells(i, "B").Copy Destination:=ws_paste.Range("C" & j)
            .Cells(i, "C").Copy Destination:=ws_paste.Range("D" & j)
            .Cells(i, "D").Copy Destination:=ws_paste.Range("F" & j)
            .Cells(i, "E").Copy Destination:=ws_paste.Range("G" & j)
            .Cells(i, "F").Copy Destination:=ws_paste.Range("H" & j)
            .Cells(i, "G").Copy Destination:=ws_paste.Range("B" & j)
            .Cells(i, "H").Copy Destination:=ws_paste.Range("E" & j)
        
        
        End If
        
   End With

Next i

End Sub

错误原因分析 #

1. Application.Match用法错误：传入整列ws_copy.Range("A:A")作为查找值，但Match函数要求查找值是单个单元格或具体值，而非整列范围。同时，当找不到匹配项时Match会返回错误值，直接与0比较会触发「类型不匹配」错误。
2. 遍历逻辑错误：原脚本遍历Raw data的行，但未正确定位Assessment中匹配的行；且j变量固定为初始值，所有匹配数据会覆盖到同一行。
3. 行号计算错误：用H列最后一行作为Raw data的遍历上限，实际应使用匹配依据的A列，避免遗漏或多遍历无关行。

修正后的脚本 #

Sub Populate()
    Dim ws_copy As Worksheet
    Dim ws_paste As Worksheet
    Dim lastRow_copy As Long, lastRow_paste As Long
    Dim i As Long, matchRow As Variant
    
    Call Open_Workbook
    
    Set ws_copy = Workbooks("Raw data.xlsx").Sheets("sheet1")
    Set ws_paste = Workbooks("Assessment.xlsx").Sheets("sheet1")
    
    ' 获取Raw data中A列有效数据的最后一行（匹配依据列，更准确）
    lastRow_copy = ws_copy.Cells(ws_copy.Rows.Count, "A").End(xlUp).Row
    ' 获取Assessment中A列有效数据的最后一行
    lastRow_paste = ws_paste.Cells(ws_paste.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Assessment的每一行（假设第1行是表头，从第2行开始）
    For i = 2 To lastRow_paste
        ' 在Raw data的A列查找当前Assessment行的A列值
        matchRow = Application.Match(ws_paste.Cells(i, "A").Value, ws_copy.Range("A:A"), 0)
        
        ' 检查是否找到有效匹配（避免错误值导致报错）
        If Not IsError(matchRow) Then
            ' 按需求将Raw data对应列赋值到Assessment指定列
            ws_paste.Cells(i, "B").Value = ws_copy.Cells(matchRow, "G").Value
            ws_paste.Cells(i, "C").Value = ws_copy.Cells(matchRow, "B").Value
            ws_paste.Cells(i, "D").Value = ws_copy.Cells(matchRow, "C").Value
            ws_paste.Cells(i, "E").Value = ws_copy.Cells(matchRow, "H").Value
            ws_paste.Cells(i, "F").Value = ws_copy.Cells(matchRow, "D").Value
            ws_paste.Cells(i, "G").Value = ws_copy.Cells(matchRow, "E").Value
            ws_paste.Cells(i, "H").Value = ws_copy.Cells(matchRow, "F").Value
            
            ' 如果需要复制格式、公式等，替换为以下Copy+PasteSpecial方式（以复制全部为例）：
            ' ws_copy.Cells(matchRow, "G").Copy
            ' ws_paste.Cells(i, "B").PasteSpecial xlPasteAll
        End If
    Next i
    
    ' 清除剪贴板，避免Excel保留复制状态
    Application.CutCopyMode = False
End Sub

修正说明 #

• 修复Match函数调用：每次传入单个单元格值进行查找，并用IsError判断匹配结果，彻底解决类型不匹配问题。
• 调整遍历逻辑：遍历Assessment的行，直接定位Raw data中匹配的行，确保数据填充到对应行，避免覆盖。
• 优化行号计算：基于匹配依据的A列计算有效行，保证遍历范围准确。
• 改用直接赋值（可选）：比Copy方法更高效，如需保留格式可切换为Copy+PasteSpecial。

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