如果键列中的值匹配，则将列数据从一个工作表复制到另一个工作表

Copy column data from one sheet to another sheet if values in key column matches

提问人：khuetran 提问时间：8/23/2023 最后编辑：braXkhuetran 更新时间：8/24/2023 访问量：40

问：

我想使用“原始数据”工作表中的数据填充评估表。这个想法是，如果“评估”中 A 列中的值与“原始数据”中 A 列中的值匹配，则“原始数据”的 B、C、D、E、F、G、H 列中的数据将被复制并粘贴到“评估”中的相应列。两张纸中的行数不同。 以下是我的脚本：

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

但是，每当执行它时，我都会收到以下错误消息：“类型不匹配”。你能帮我解决这个问题吗？ 先谢谢你！

Excel VBA for 循环 if 语句

评论

0赞 Black cat 8/23/2023
在VBA中不能使用数组函数。查找值必须是类型并包含数据。Variant
0赞 khuetran 8/23/2023
有没有办法在 2 张纸之间检查 A 列中的值，而不是使用 application.match？
0赞 Black cat 8/23/2023
是的，该方法可以做到。Range.Find

答：

0赞 Black cat 8/23/2023 #1

我做了一些更改以符合 VBA。

  • 必须测试错误值是否匹配结果。

  • 循环访问“原始数据”的“A 列”值。

  • 复制/粘贴后的增量计数器j

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
        On Error Resume Next
        If WorksheetFunction.Match(ws_copy.Range("A" & i), ws_paste.Range("A:A"), 0) <> 0 Then
            If Err <> 0 Then
            Else
            .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)
            j = j + 1
            End If
        End If
        On Error Goto 0        
   End With

Next i

End Sub

上一个：当单元格值匹配时，使用 vba 以正确的顺序将所有数据从一个工作表复制到另一个工作表

下一个：搜索字符串和与该字符串对应的输出值