比较范围并在VBAmacros中填充值

我正在尝试编写一个macros来比较Excel中的两个范围，Rng1和Rng2。 Rng1（“f2：f15”）包含正在使用的目标号码。 Rng2，（“a2：a91”）包含所有可能目标的编号。 Rng2右边的三列（“b2：b91”），（“c2：c91”）和（“d2：d91”）包含与每个目标编号关联的x，y和z坐标值。 我想让这个macros做的是在Rng1右边的3列（“g2：g15”），（“h2：h15”）和（“i2：i15”）中填充坐标值在Rng1中find的目标号码。 我写的下面的代码是重新调整“运行时错误”13，types不匹配“。

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