|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
'从sheet2中复制满足sheet1的记录(字段名可以缺少,相当于vlookup)到sheet1中
Dim Dic As Object
Dim arr, i, j, brr
Set Dic = CreateObject("scripting.dictionary") '建立字典
arr = Worksheets("sheet1").[a1].CurrentRegion 'sheet1工作表以A1单元格连续的区域装进数组arr
brr = Worksheets("sheet2").[a1].CurrentRegion 'sheet2工作表以A1单元格连续的区域装进数组brr
For i = 2 To UBound(brr) '设置变量i,从brr数组第2行开始循环
For j = 2 To UBound(brr, 2) '设置变量j,从brr数组第2列开始循环
Dic(brr(i, 1) & brr(1, j)) = brr(i, j) '以brr(i,1)和brr(1,j)作为条件,结果为brr(i,j),装进字典中。
Next
Next
For i = 2 To UBound(arr) '设置变量i,从arr数组第2行开始循环
For j = 2 To UBound(arr, 2) '设置变量j,从arr数组第2列开始循环
arr(i, j) = Dic(arr(i, 1) & arr(1, j)) '以arr(i,j)为结果,从字典中查找对应的条件arr(i,1)和arr(1,j)。{注:条件arr(i,1) & arr(1,j) = brr(i,1) & brr(1,j)}
Next
Next
Worksheets("sheet1").[a1].Resize(UBound(arr), UBound(arr, 2)) = arr '将arr数组导出到sheet1工作表以A1单元格连续的区域
End Sub |
评分
-
1
查看全部评分
-
|