Question

我正在尝试编写一个宏来比较excel中的两个范围Rng1和Rng2。 Rng1，（＆＃34; f2：f15＆＃34;）包含正在使用的目标号码。 Rng2，（＆＃34; a2：a91＆＃34;）包含所有可能目标的编号。 Rng2右侧的三列，（＆＃34; b2：b91＆＃34;），（＆＃34; c2：c91＆＃34;）和（＆＃34; d2：d91＆＃34;）包含与每个目标编号关联的x，y和z坐标值。我希望这个宏做的是填充Rng1右侧的3列，（＆＃34; g2：g15＆＃34;），（＆＃34; h2：h15＆＃34;）和（＆＃ 34; i2：i15＆＃34;），其中包含在Rng1中找到的目标编号的坐标值。我写的以下代码是重新调整＆＃34;运行时错误＆＃39; 13＆＃39;，输入不匹配＆＃34;。

Sub macro()
Dim Rng1 As Range, Rng2 As Range, Cell1 As Range, Cell2 As Range
Set Rng1 = Range("f2:f15")
Set Rng2 = Range("a2:a91")
For i = 1 To Rng1
    For j = 1 To Rng2
        For Each Cell1 In Rng1(i)
            For Each Cell2 In Rng1(j)
               If Cell1.Value = Cell2.Value Then
                'cell1.Offset(0, 1) = cell2.Offset(0, 1)
                'cell1.Offset(0, 1) = cell2.Offset(0, 1)
                'cell1.Offset(0, 1) = cell2.Offset(0, 1)
                Cells(2 + i, 7) = Cells(2 + j, 2)
                Cells(2 + i, 8) = Cells(2 + j, 3)
                Cells(2 + i, 9) = Cells(2 + j, 4)
             End If
          Next Cell2
       Next Cell1
     Next j
  Next i

End Sub

谢谢！

Answer 1

根据您的描述，我认为这就是您想要的

Sub Demo()
    Dim Rng1 As Range, Rng2 As Range, Cell1 As Range
    Dim i As Variant
    Set Rng1 = Range("f2:f15")
    Set Rng2 = Range("a2:a91")

    '  Loop over the cells you want to add data for
    For Each Cell1 In Rng1
        ' locate current value in range 2
        i = Application.Match(Cell1.Value, Rng2, 0)
        If Not IsError(i) Then
            ' if found copy offset data
            Cell1.Offset(0, 1) = Rng2.Cells(i, 2)
            Cell1.Offset(0, 2) = Rng2.Cells(i, 3)
            Cell1.Offset(0, 3) = Rng2.Cells(i, 4)
        End If
    Next
End Sub

比较范围并填充VBA宏中的值

1 个答案: