- 帖子
- 2025
- 主題
- 13
- 精華
- 0
- 積分
- 2053
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- Office2007
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台北市
- 註冊時間
- 2011-3-2
- 最後登錄
- 2024-3-14
     
|
回復 4# pipi1968
你目前陣列宣告方式可以參考 Sub ex2()
Sub ex()
Set d = CreateObject("Scripting.Dictionary")
ar = Array(Array("AA", "yes", "Cr", 111, 222), _
Array("BB", "No", "Dr", 333, 444), _
Array("CC", "yes", "Bl", 111, 222), _
Array("AA", "yes", "Cr", 222, 333), _
Array("CC", "yes", "Bl", 333, 555), _
Array("CC", "yes", "Bl", 222, 111), _
Array("BB", "No", "Dr", 444, 222))
For i = LBound(ar) To UBound(ar)
If Not d.exists(ar(i)(0)) Then
d(ar(i)(0)) = ar(i)
Else
a = d(ar(i)(0))
a(3) = a(3) + ar(i)(3)
a(4) = a(4) + ar(i)(4)
d(ar(i)(0)) = a
End If
Next
[a1].Resize(7, 5) = Application.Transpose(Application.Transpose(ar))
[a9].Resize(d.Count, 5) = Application.Transpose(Application.Transpose(d.Items))
End Sub
Sub ex2()
Set d = CreateObject("Scripting.Dictionary")
ar = [A1:E7]
For i = LBound(ar) To UBound(ar)
If Not d.exists(ar(i, 1)) Then
d(ar(i, 1)) = Array(ar(i, 1), ar(i, 2), ar(i, 3), ar(i, 4), ar(i, 5))
Else
a = d(ar(i, 1))
a(3) = a(3) + ar(i, 4)
a(4) = a(4) + ar(i, 5)
d(ar(i, 1)) = a
End If
Next
' [a1].Resize(7, 5) = Application.Transpose(Application.Transpose(ar))
[a13].Resize(d.Count, 5) = Application.Transpose(Application.Transpose(d.Items))
End Sub |
|
發表於 2016-3-15 22:31
| 