|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
結果放在 Sheet2, 自行手動增加:
Sub TEST_A1()
Dim Arr, Brr, xD, A As Range, R&, C&, Cx&, i&, j%
[Sheet2!A:Z].ClearContents
Set xD = CreateObject("Scripting.Dictionary")
Arr = [Sheet1!m1].CurrentRegion
C = UBound(Arr, 2): Cx = Cx + C
ReDim Brr(1 To UBound(Arr), 1 To 200)
For i = 1 To UBound(Arr)
For j = 1 To C: Brr(i, j) = Arr(i, j): Next
xD(Arr(i, 1)) = i
Next i
For Each A In Union([Sheet1!r1], [Sheet1!v1])
Arr = A.CurrentRegion
C = UBound(Arr, 2) - 1
For i = 1 To UBound(Arr)
R = xD(Arr(i, 1)): If R = 0 Then GoTo 101
For j = 1 To C
Brr(R, Cx + j) = Arr(i, j + 1)
Next
101: Next i
Cx = Cx + C
Next A
[Sheet2!a1].Resize(UBound(Brr), Cx) = Brr
End Sub
|
评分
-
1
查看全部评分
-
|