在excel中如何比较2个表格中的A列并将匹配的行复制到Sheet3?

我是Visual Basic的新手,我想要帮助尝试一些东西 .

我想比较Sheet1中的所有A列和Sheet2中的A列,如果找到完全匹配,则将整个匹配行从Sheet2复制到Sheet3 .

提前致谢 .

回答(1)

2 years ago

我的答案的修改版本来自This Question

Sub CopyMatch()

Dim StartingScreenUpdateValue As Boolean
Dim StartingEventsValue As Boolean
Dim StartingCalculations As XlCalculation

With Application
    StartingScreenUpdateValue = .ScreenUpdating
    StartingEventsValue = .EnableEvents
    StartingCalculations = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With


Dim varTestValues As Variant
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As WorkSheet

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")

With sh2
    varTestValues = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
End With

With sh1
    .Range("A1", .Range("A" & .Rows.Count).End(xlUp)) _
    .AutoFilter Field:=1, Criteria1:=Application.Transpose(varTestValues), Operator:=xlFilterValues

    .Range("A2", sh1.Range("A" & .Rows.Count).End(xlUp)) _
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy sh3.Range("A1")

    .AutoFilterMode = False
End With

With Application
    .ScreenUpdating = StartingScreenUpdateValue
    .EnableEvents = StartingEventsValue
    .Calculation = StartingCalculations
End With

End Sub

NOTE: 此代码运行假设您的数据有 Headers ,如果它没有请建议 .

REMEMBER 始终在数据副本上运行任何代码,而不是实际数据,直到您确信它100%正常工作 .