- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 142
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2026-7-16
                
|
回復 3# ivan731129 - Sub Ex()
- Dim Sh As Worksheet, A As Range, k%, r&, Mystr$
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- For Each Sh In Sheets
- With Sh
- If .Name <> "集合檔" Then
- k = k + 1
- For Each A In .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
- Mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 11))), ",")
- If IsEmpty(d(A.Value)) Then '沒有的項目就加入
- d(A.Value) = d(A.Value) + 1 '計算次數
- d1(A.Value) = Mystr '紀錄內容
- ElseIf d1(A.Value) = Mystr Then '相同時計算次數
- d(A.Value) = d(A.Value) + 1 '計算次數
- ElseIf d1(A.Value) <> Mystr Or d(A.Value) <> k Then '有不同或是與工作表數量不同
- d1.Remove A.Value '移除項目
- End If
- Next
- End If
- End With
- Next
- With Sheets("集合檔")
- .Cells = ""
- For Each ky In d1.keys
- r = r + 1
- .Cells(r, 1).Resize(, 11) = Split(d1(ky), ",") '寫入集合檔
- Next
- End With
- End Sub
|
|
發表於 2011-3-2 10:05
| 