- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 91
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-4-15
               
|
回復 7# aok669 - Sub Ex()
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- Dim A As Range, B As Range, C As Range, r&
- For Each sh In Sheets(Array("投信", "外資", "主力"))
- With sh
- r = 3
- Do Until .Cells(r, 2) = ""
- Set A = .Cells(r, 2)
- Set B = .Cells(r, 7)
- d(A.Text) = Array(A.Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
- d(B.Text) = Array(B.Value, B.Offset(, 2).Value, B.Offset(, 3).Value) '加入這行
- d1(A & sh.Name & .[A1]) = A.Offset(, 1).Value
- d1(B & sh.Name & .[F1]) = B.Offset(, 1).Value
- r = r + 1
- Loop
- End With
- Next
- With Sheets("main")
- .[A3:F65536,I3:K65536] = ""
- .[A3].Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
- r = 3
- For Each ky In d.keys
- For Each i In Array(4, 5, 6, 9, 10, 11)
- Set A = .Cells(r, i)
- Set B = .Cells(2, i)
- Set C = .Cells(1, i).MergeArea(1)
- A.Value = d1(ky & B & C)
- Next
- r = r + 1
- Next
- End With
- End Sub
|
|
發表於 2010-12-15 11:10
| 