比较范围并在 VBA 宏中填充值
compare ranges and populate values in VBA Macro
我正在尝试编写一个宏来比较 excel 中的两个范围 Rng1 和 Rng2。 Rng1 ("f2:f15"),包含正在使用的目标编号。 Rng2 ("a2:a91"),包含所有可能目标的编号。 Rng2 右侧的三列 ("b2:b91")、("c2:c91") 和 ("d2:d91") 包含与每个目标编号关联的 x、y 和 z 坐标值。我希望这个宏做的是用 Rng1 的坐标值填充 Rng1 右侧的 3 列,("g2:g15")、("h2:h15") 和 ("i2:i15")在 Rng1 中找到的目标编号。我编写的以下代码正在重新调整 "Run time error '13', type mismatch".
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
谢谢!
根据你的描述我想这就是你想要的
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
我正在尝试编写一个宏来比较 excel 中的两个范围 Rng1 和 Rng2。 Rng1 ("f2:f15"),包含正在使用的目标编号。 Rng2 ("a2:a91"),包含所有可能目标的编号。 Rng2 右侧的三列 ("b2:b91")、("c2:c91") 和 ("d2:d91") 包含与每个目标编号关联的 x、y 和 z 坐标值。我希望这个宏做的是用 Rng1 的坐标值填充 Rng1 右侧的 3 列,("g2:g15")、("h2:h15") 和 ("i2:i15")在 Rng1 中找到的目标编号。我编写的以下代码正在重新调整 "Run time error '13', type mismatch".
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
谢谢!
根据你的描述我想这就是你想要的
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