- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 101
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-5-2
              
|
回復 1# wsx24680
不知是不是這個意思- Sub Ex_1() 'Sheet2跟Sheet3相加
- Dim A As Range
- Set d = CreateObject("Scripting.Dictionary")
- d("Item") = Array("ITEM", "NO.", "COUNT")
- For Each Sh In Sheets(Array("Sheet2", "Sheet3"))
- With Sh
- For Each A In .Range(.[A2], .[A65536].End(xlUp))
- If IsEmpty(d(A & A.Offset(, 1))) Then
- d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), A.Offset(, 2))
- Else
- ar = d(A & A.Offset(, 1))
- ar(2) = ar(2) + A.Offset(, 2)
- d(A & A.Offset(, 1)) = ar
- End If
- Next
- End With
- Next
- With Sheet3.[F1].Resize(d.Count, 3)
- .Value = Application.Transpose(Application.Transpose(d.items))
- .Sort key1:=.Cells(1, 1), Header:=xlYes
- End With
- End Sub
- Sub Ex_2() 'Sheet1計數
- Dim A As Range
- Set d = CreateObject("Scripting.Dictionary")
- With Sheet1
- d("Item") = Array("ITEM", "NO.", "COUNT")
- For Each A In .Range(.[A2], .[A65536].End(xlUp))
- If IsEmpty(d(A & A.Offset(, 1))) Then
- d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), 1)
- Else
- ar = d(A & A.Offset(, 1))
- ar(2) = ar(2) + 1
- d(A & A.Offset(, 1)) = ar
- End If
- Next
- End With
- With Sheet1.[F1].Resize(d.Count, 3)
- .Value = Application.Transpose(Application.Transpose(d.items))
- .Sort key1:=.Cells(1, 1), key2:=.Cells(1, 2), Header:=xlYes
- End With
- End Sub
|
|
發表於 2010-5-23 22:20
| 
