|
楼主 |
发表于 2017-1-14 07:56
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
一个跨表查询的案例:
Sub lsc()
Dim d, Arr, brr, crr, x, y, i, j
Set d = CreateObject("Scripting.Dictionary")
Arr = Sheet1.UsedRange
For i = 2 To UBound(Arr)
d(Arr(i, 1)) = Array(Arr(i, 2), Arr(i, 3), Arr(i, 4))
Next
With Sheet2
x = .Range("a1048576").End(3).Row
y = .Range("b1048576").End(3).Row + 1
brr = .Range("a" & y & ":a" & x)
ReDim crr(1 To UBound(brr), 1 To 3)
For i = 1 To UBound(brr)
For j = 0 To UBound(d(brr(i, 1)))
crr(i, j + 1) = d(brr(i, 1))(j)
Next
Next
.Range("b" & y).Resize(UBound(brr), 3) = crr
End With
Set d = Nothing
End Sub |
评分
-
1
查看全部评分
-
|