Set d = CreateObject("scripting.dictionary") For i = 1 To UBound(rng) d(rng(i, 1)) = rng(i, 2

Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(rng)
d(rng(i, 1)) = rng(i, 2)
Next i
Sheets("CAD").Select
rng1 = Range([a2], [e6000].End(xlUp))
For l = 1 To UBound(rng1)
k = k + 1
ReDim Preserve arr(1 To 6, 1 To k)
arr(1, k) = rng1(l, 1)
arr(2, k) = rng1(l, 2)
arr(3, k) = rng1(l, 3)
arr(4, k) = rng1(l, 4)
arr(5, k) = d(rng1(l, 1))
arr(6, k) = rng1(l, 5)
Next l
Range("g2").Value = "当前坐标数为:" & k & "条记录"
Sheets("合并记录").Select
[a1].Resize(k, 6) = Application.Transpose(arr)
rng2 = Range("a1").CurrentRegion
谁帮我解释下什么意思,谢谢了

Set d = CreateObject("scripting.dictionary") '创建字典
For i = 1 To UBound(rng)'从数组rng第一行到最后一行循环
d(rng(i, 1)) = rng(i, 2)'把数组rng第一列作为关键字,第二列为对应的值装入字典
Next i
Sheets("CAD").Select '选择工作表"CAD"
rng1 = Range([a2], [e6000].End(xlUp))'把a2到e列最后一行装入数组rng1
For l = 1 To UBound(rng1)'从数组rng1第一行到最后一行循环
k = k + 1'自加
ReDim Preserve arr(1 To 6, 1 To k)’在数组arr后面增加一列
arr(1, k) = rng1(l, 1)
arr(2, k) = rng1(l, 2)
arr(3, k) = rng1(l, 3)
arr(4, k) = rng1(l, 4)
arr(5, k) = d(rng1(l, 1))
arr(6, k) = rng1(l, 5)'以上把对应的值装入数组新列
Next l
Range("g2").Value = "当前坐标数为:" & k & "条记录"'写入g2单元格
Sheets("合并记录").Select '选择工作表"合并记录"
[a1].Resize(k, 6) = Application.Transpose(arr)'把arr转置后写入a1开始的k行6列区域
rng2 = Range("a1").CurrentRegion'把a1相连的矩形区域装入数组rng2
温馨提示:答案为网友推荐,仅供参考