Question

我想比较两列并复制第1列中找到的比较值旁边的4个单元格，这一行应该被复制到第一个空行的第2列中。

Sub Find_Matches()

    Dim CompareRange1 As Variant, CompareRange2 As Variant, x As Variant, y As Variant
    ' Set CompareRange equal to the range to which you will
    ' compare the selection.
    Set CompareRange1 = Range("A1:A10")
    Set CompareRange2 = Range("H1:H30") 
    For Each x In CompareRange1
        For Each y In CompareRange2
            Dim a As Variant
            Set a = x.Offset(0,4)
            If x = y Then y.Offset(1, 4) = a
        Next y
    Next x
End Sub

Answer 1

我认为这会做你想要的事情：

Sub Find_Matches()
    Dim CompareRange1 As Variant, CompareRange2 As Variant, x As Variant, y As Variant
    Set CompareRange1 = Range("A1:A10")
    Set CompareRange2 = Range("H1:H30")
    For Each x In CompareRange1
        For Each y In CompareRange2
            If x = y Then y.Offset(, 1).Resize(, 4).Value = x.Offset(, 1).Resize(, 4).Value
        Next y
    Next x
End Sub

我想比较两列和复制单元格

1 个答案: