- 帖子
- 561
- 主題
- 160
- 精華
- 0
- 積分
- 725
- 點名
- 0
- 作業系統
- WINDOWS
- 軟體版本
- xp
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2014-9-10
- 最後登錄
- 2026-2-12
  
|
4#
發表於 2020-7-14 08:58
| 只看該作者
dear sirs
1.如下將程式copy至需求excel 僅將 sheet1改sheet62 sheet2改sheet106
1.1 停於 Arr = Range([Sheet62!d1], [Sheet62!a65536].End(3))
出現 "此處須要物件" 無法執行???
2.煩不吝賜教 thanks
Sub TEST()
Dim Arr, Brr, xD, i&, T$, U, a, b, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Sheet62!d1], [Sheet62!a65536].End(3))
For i = 1 To UBound(Arr)
T = Arr(i, 1) & IIf(Arr(i, 2) = "A01", "", "|")
xD(T) = Trim(xD(T) & " " & i)
Next i
ReDim Brr(1 To 30000, 1 To 4)
For Each U In xD.keys
If xD(U & "|") = "" Then GoTo 101
For Each a In Split(xD(U), " ")
For Each b In Split(xD(U & "|"), " ")
N = N + 2
For i = 1 To 4
Brr(N - 1, i) = Arr(a, i)
Brr(N, i) = Arr(b, i)
Next
Next
Next
101: Next
[Sheet106!A1 1].Resize(N) = Brr
End Sub |
|