- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# enhrulee
試試看- Sub Ex()
- Dim D As Object, DX As Object, Rng As Range
- Set D = CreateObject("SCRIPTING.DICTIONARY") '今日報價 物件
- Set DX = CreateObject("SCRIPTING.DICTIONARY") '今日報價*今日單量 物件
- Set Rng = Sheets("今日報價").Range("A2")
- Do While Rng <> "" '取得 產品今日報價物件的 迴圈
- D(Rng.Value) = Rng.Offset(, 1).Value
- Set Rng = Rng.Offset(1) '設定為往下一列
- Loop
- Set Rng = Sheets("今天交易").Range("A2")
- Do While Rng <> "" '取得 今日產品報價 * 今天單量 =金額 的迴圈
- If DX.EXISTS(Rng.Value) Then '今日產品單量已出現
- DX(Rng.Value) = DX(Rng.Value) + D(Rng.Value) * Rng.Offset(, 1).Value
- Else
- DX(Rng.Value) = D(Rng.Value) * Rng.Offset(, 1).Value
- End If
- 'DX.EXSITS(Rng.Value) 今天交易的產品名稱存在
- 'D(Rng.Value) 產品 今日報價
- 'Rng.Offset(, 1).Value 產品 今日單量
- 'DX(Rng.Value) 今天單量*今日報價
- Set Rng = Rng.Offset(1)
- Loop
- With Sheets("交易紀錄")
- If .Range("C1") <> Date Then '不是當日
- .Columns("C:C").Insert
- .Columns("V:V") = ""
- .Range("C1") = Date
- End If
- Set Rng = .Range("A2")
- Do While Rng <> "" '取得 今天有交易紀錄 產品 的迴圈
- If DX.EXISTS(Rng.Value) Then Rng.Offset(, 2) = DX(Rng.Value)
- '產品今日有交易 C欄輸入總金額
- Rng.Offset(, 1) = "=SUM(" & Rng.Offset(, 2).Resize(1, 20).Address & ")" '
- 'B欄輸入公式
- Set Rng = Rng.Offset(1)
- Loop
- End With
- End Sub
|
|
發表於 2011-7-23 14:42
| 