- 帖子
- 967
- 主題
- 0
- 精華
- 0
- 積分
- 1001
- 點名
- 0
- 作業系統
- WIN XP
- 軟體版本
- OFFICE 2003
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-11-29
- 最後登錄
- 2022-5-17
 
|
本帖最後由 register313 於 2012-4-28 18:25 編輯
回復 4# white5168
是有許多疑點未釐清
總之先給些數據(一般的算法),再一步一步弄清楚吧- Sub aa()
- Dim d1, d2 As Object
- Set d1 = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- [G1:I65536] = ""
- [G1:I1] = Array("產品編號", "剩餘數量", "平均價格")
- For B = 2 To [B2].End(xlDown).Row
- If Not d1.exists(Cells(B, 2).Value) Then
- d1.Add Cells(B, 2).Value, Cells(B, 4) - Cells(B, 5)
- d2.Add Cells(B, 2).Value, (Cells(B, 4) - Cells(B, 5)) * Cells(B, 3)
- Else
- d1(Cells(B, 2).Value) = d1(Cells(B, 2).Value) + Cells(B, 4) - Cells(B, 5)
- d2(Cells(B, 2).Value) = d2(Cells(B, 2).Value) + (Cells(B, 4) - Cells(B, 5)) * Cells(B, 3)
- End If
- Next B
- [G2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
- [H2].Resize(d1.Count, 1) = Application.Transpose(d1.items)
- [I2].Resize(d2.Count, 1) = Application.Transpose(d2.items)
- For I = 2 To d2.Count + 1
- If Cells(I, "H") = 0 Then
- Cells(I, "I") = 0
- Else
- Cells(I, "I") = Cells(I, "I") / Cells(I, "H")
- End If
- Next I
- End Sub
|
|
發表於 2012-4-28 14:28
| 
