- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 81
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-4-5
               
|
回復 14# b9208 - Sub ex()
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- With Sheets("Sheet1")
- For Each a In .Range(.[B8], .[B8].End(xlDown))
- m = a.Text & "," & a.Offset(, 2) & "," & a.Offset(, 4)
- n = a.Text & "," & a.Offset(, 1) & "," & a.Offset(, 2)
- If d(m) <= a.Offset(, 7) Then _
- d(m) = a.Offset(, 7) '取出B、D、F欄同組最大值
- d1(n) = "" 'B、C、D欄不重複索引
- Next
- End With
- For Each ky In d.keys
- ar = Split(ky, ",")
- d(ar(0) & ar(1)) = d(ar(0) & ar(1)) + d(ky) '取出B、D、F欄同組加總
- Next
- For Each ky In d1.keys
- ar = Split(ky, ",")
- d1(ar(0) & ar(2)) = d1(ar(0) & ar(2)) + 1 ''B、C、D欄組合計數
- Next
- With Sheets("Sheet2")
- For Each c In .[O7:P7]
- cnt = 0
- For Each a In .[N8:N14]
- .Cells(a.Row, c.Column) = IIf(d1(a & c) = "", 0, d1(a & c)) '依序填入組合計數
- cnt = cnt + d1(a & c)
- Next
- .Cells(15, c.Column) = cnt
- Next
- For Each c In .[O7:P7]
- cnt = 0
- For Each a In .[N19:N25]
- .Cells(a.Row, c.Column) = IIf(d(a & c) = "", 0, d(a & c)) '依序填入組合加總
- cnt = cnt + d1(a & c)
- Next
- .Cells(26, c.Column) = cnt
- Next
- End With
- End Sub
 T1.rar (13.39 KB)
|
|
發表於 2013-4-24 22:47
| 
