[發問] 請問如何用excel VBA寫一個以先進先出的方式來取得產品的數量與平均價格 FIFO

white5168

個問大大如題
請問如何用excel VBA寫一個以先進先出的方式來取得產品的數量與平均價格
有以下的資料,但小弟實在想不出該如何寫出來,買進賣出須以日期為主
要取得目前產品的剩餘數量與剩餘數量的成本均價,產品明細如附件

購買日期,產品編號,購買價格,進貨數量,出貨數量
20120102,1166,27,0,2000
20120102,116P,27.2,0,2000
20120102,5511,27.2,0,1000
20120102,5515,27.1,0,1000
20120102,585J,27,5000,0
20120102,585J,27.05,1000,0
20120102,592a,27.1,1000,0
20120102,5962,27.2,0,2000
20120102,616K,27.25,0,1000
20120102,7001,27,0,2000
20120102,7001,27.05,0,1000
20120102,7001,27.1,0,1000
20120102,700K,27.3,1000,0
20120102,779z,27.7,0,1000
20120102,8560,27.05,1000,0
20120102,8560,27.1,2000,0
20120102,8560,27.25,1000,0
20120102,8560,27.7,0,3000
20120102,8843,27,0,1000
20120102,9108,27.25,1000,0
20120102,9108,27.7,0,1000
20120102,913R,27.7,5000,0
20120102,9187,27.05,0,1000
20120102,9313,27.3,0,1000
20120102,9363,27,0,1000
20120102,9801,27.2,10000,0
20120102,9817,27.1,0,1000
20120102,983Z,27.2,0,3000
20120102,984C,27.25,0,1000
20120102,984K,27,2000,0
20120102,9887,27,0,1000
20120102,9887,27.2,0,2000
20120103,1035,27.05,2000,0
20120103,1160,27.45,5000,0
20120103,1166,27.05,0,1000
20120103,116L,27.05,0,1000
20120103,116L,27.45,0,1000
20120103,538N,27.45,0,2000
20120103,572D,27.5,0,5000
20120103,5926,27.05,4000,0
20120103,592M,27.5,0,2000
20120103,7003,27.45,2000,0
20120103,7003,27.5,10000,0
20120103,700K,27.45,0,1000
20120103,700W,27.05,1000,0
20120103,700j,27.05,4000,0
20120103,8560,27.05,2000,0
20120103,8560,27.45,0,1000
20120103,8560,27.5,0,2000
20120103,8850,27.45,0,1000
20120103,9183,27.45,1000,0
20120103,9185,27.05,1000,0
20120103,918D,27.05,0,10000
20120103,921Y,27.05,0,1000
20120103,9303,27.05,1000,0
20120103,9303,27.5,0,1000
20120103,9649,27.05,0,1000
20120103,979H,27.05,0,1000
20120103,9817,27.45,0,2000
20120104,1035,26.8,0,3000
20120104,1112,27,0,1000
20120104,1162,27.3,1000,0
20120104,116G,26.85,0,1000
20120104,5182,27,0,1000
20120104,551X,27,0,1000
20120104,585V,26.8,0,6000
20120104,700K,27.15,1000,0
20120104,700j,26.8,6000,0
20120104,700j,27,1000,0
20120104,8560,26.8,0,1000
20120104,8560,27,1000,0
20120104,8560,27.15,0,1000
20120104,8560,27.3,0,1000
20120104,884A,26.8,0,3000
20120104,9108,27,1000,0
20120104,9135,27.15,0,2000
20120104,9183,27.15,0,1000
20120104,9274,26.85,1000,0
20120104,9647,27,1000,0
20120104,9801,26.8,8000,0
20120104,981a,26.8,0,5000
20120104,982A,26.8,1000,0
20120104,9887,27,0,2000
20120104,9891,27,1000,0
20120104,989V,26.8,3000,0
20120104,989V,27.15,2000,0
20120104,989Z,27.15,1000,0

Hsieh

回復 22# white5168
把整體流程概念註解後，看看與你的想法落差在哪?

1. Sub Get_Data()
   
2. Dim Ar(), Ay(), x, Mystr$, A
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. ChDir ThisWorkbook.Path
   
7. fs = Application.GetOpenFilename("逗點分隔 (CSV) (*.csv), *.csv") '開啟資料檔案對話方塊選擇CSV檔案
   
8. 
   
9. Open fs For Input As #1 '讀取CSV檔案
   
10. Do Until EOF(1)
    
11.    Line Input #1, Mystr '讀取一行資料寫入變數
    
12.    A = Split(Mystr, ",") '將資料切割存入陣列
    
13.    If Val(A(0)) > 0 And Val(A(0)) <= [B1] Then '判斷是否在結算日期之前的資料
    
14.    If IsEmpty(d(A(1))) Then '以產品編號為索引若不存在
    
15.        For i = 1 To Val(A(3)) '以買入數量做迴圈、記憶住每一個的單價
    
16.           ReDim Preserve Ar(i)
    
17.           Ar(i - 1) = Val(A(2))
    
18.        Next
    
19.        If Val(A(3)) > 0 Then d(A(1)) = Ar '如果有數量就將陣列存到字典中
    
20.        Else '也就是有第二筆以上買入時執行
    
21.        Ar = d(A(1)) '先取出該編號已經購買的資料存入陣列
    
22.        s = UBound(Ar)
    
23.          For i = 1 To Val(A(3)) '將每筆資料單價加入此陣列
    
24.            ReDim Preserve Ar(s + i)
    
25.            Ar(s + i - 1) = Val(A(2))
    
26.          Next
    
27.        s = UBound(Ar)
    
28.          d(A(1)) = Ar '將陣列回存到字典物件
    
29.     End If
    
30.     If Val(A(4)) > 0 Then '賣出資訊處理，與買入觀念相同
    
31.        If IsEmpty(d1(A(1))) Then
    
32.        For i = 1 To Val(A(4))
    
33.           ReDim Preserve Ar(i)
    
34.           Ar(i - 1) = Val(A(2))
    
35.        Next
    
36.        If Val(A(4)) > 0 Then d1(A(1)) = Ar
    
37.        Else
    
38.        Ar = d1(A(1))
    
39.        s = UBound(Ar)
    
40.          For i = 1 To Val(A(4))
    
41.            ReDim Preserve Ar(s + i)
    
42.            Ar(s + i - 1) = Val(A(2))
    
43.          Next
    
44.          d1(A(1)) = Ar
    
45.     End If
    
46.     End If
    
47.     End If
    
48.    Erase Ay: Erase Ar '處理下一筆資料前先把原來的買賣記憶消除
    
49. Loop
    
50. Close #1 '關閉CSV檔案
    
51. For Each ky In d1.keys
    
52.    If IsArray(d1(ky)) Then Ar = d1(ky): x = UBound(Ar) Else x = 0 '出貨資料若是陣列就取出陣列可得知到底有幾筆出貨資訊
    
53.    If IsArray(d(ky)) Then Ay = d(ky): y = UBound(Ay) Else y = 0 '進貨資料若是陣列就取出陣列可得知到底有幾筆進貨資訊
    
54.    '以下就不同狀況計算各欄位應有的值寫入陣列
    
55.    If x = 0 And y > 0 Then '只進不出
    
56.         bp = Application.Average(Ay) '進貨平均價
    
57.       d2(ky) = Array(ky, y, 0, 0, Abs(y - x), y - x, Round(bp, 2), 0)
    
58.       bp = 0
    
59.       ElseIf y = 0 And x > 0 Then '只出不進
    
60.       sp = Application.Average(Ar) '出貨平均價
    
61.       d2(ky) = Array(ky, y, x, 0, 0, y - x, 0, Round(sp, 2))
    
62.       sp = 0
    
63.       ElseIf x > 0 And y > 0 Then
    
64.          If x > y Then '出大於進
    
65.          w = 0: w1 = y - x
    
66.          For i = 0 To y - 1
    
67.          pr = pr + Ar(i) - Ay(i) '計算出貨與進貨的價差累計、這是真正獲利值可能與提問者的觀念差異
    
68.          Next
    
69.          For j = i To x - 1 '不夠扣計算
    
70.          nr = nr + Ar(i)
    
71.          Next
    
72.          nr = nr / (x - y) '不足量
    
73.          ElseIf x < y Then '進大於出
    
74.          w1 = 0: w = y - x
    
75.          For i = 0 To x - 1
    
76.          pr = pr + Ar(i) - Ay(i) '計算出貨與進貨的價差累計、這是真正獲利值可能與提問者的觀念差異
    
77.          Next
    
78.          For j = i To y - 1 '剩餘量計算
    
79.          sr = sr + Ay(i)
    
80.          Next
    
81.          sr = sr / Abs(x - y) '不足量
    
82.          End If
    
83.          d2(ky) = Array(ky, y, x, pr, w, w1, Round(sr, 2), Round(nr, 2)) '寫入陣列
    
84.          pr = 0: nr = 0: sr = 0
    
85.    End If
    
86.    Erase Ay: Erase Ar
    
87. Next
    
88. [A4:H65536] = ""
    
89. [A4].Resize(d2.Count, 8) = Application.Transpose(Application.Transpose(d2.items))
    
90. End Sub

複製代碼

register313

回復 25# white5168

先前在另一帖裡(與本帖內容相同,重覆發帖了)已作回覆
Hsieh超版在本帖裡亦作了回覆

附上H版與R版程式執行結果之比較供參考,有不對的地方再作回覆
黃色網底即為2個版本不同之處

下載 (337.91 KB)

2012-5-2 09:09

最後資料 R版vsH版.rar (8.32 KB)

下載次數: 15

2012-5-2 09:09

white5168

bbojj大大
的確是每日各股在全台所有劵商的成交明細,我是用python抓下來(用Excel VBA抓資料會很慢,而且會當,因為每天的資料量就約70MB~90MB),如再加上要分析這些資料鐵定更慘
因此以python抓資料(國外已有將python定位為金融的程式語言),MySQL或Access存資料,Excel VBA來作資料分析才會是不錯的架構選擇,只可惜目前這裡並沒有遇到會使用python的人,有興趣可以相互討論,也建議板主能開一個python的討論版
離題了,真抱歉,我還是先乖乖學好Excel VBA

wang

對不起  會錯意  自刪

white5168

謝謝Hsieh大大的回覆
我想只能先試試看您所貼的程式碼,至於附件的部份等升級後再下載,先試試看相關的部分是否可行

其實原始資料中還有包含從今年年初到現在的交易日期,廠商,而每家廠商的商品又不相同, 又怕大家看了會更頭昏,所以我目前只列商品的買賣明細
等我先看大大寫的完後再跟您請益當加入廠商後的資訊,我可以先預告廠商有1090多家,而每家賣的商品加加減減的總共有1400多樣,而這兩邊的資料量還在增加當中,相信這樣的難度又更高
希望能從大大的經驗中吸取處理這樣龐大資料的方法

Hsieh

回復 20# white5168
我並非科班出身，只懂一點VBA皮毛，其他程式不懂
至於您所謂模組化，我並不了解其義
如果您確定貼圖資料是正確，那我的程式碼跑出來結果就必然是錯的
必須再來看看哪邊出問題了

white5168

很感謝Hsieh大大幫忙,不過目前我還無法下載所有大大所回覆的附件,只能等到升級後才能看到結果
想請問Hsieh大大, Excel VBA的程式,是否能做到跟C,C++等高階語言一樣模組化的程度?
這裡我要澄清說明,附件的原始資料的確是貼圖的資料,我只是將原始資料中比較簡單的不複雜的資料項剔除
貼圖的資料是我將原始資料留下複雜的部份來做說明用的
在撰寫程式的過程中會遇到問題的資料,基本上程式撰寫只要複雜的能寫的出來,其他的都不成問題
可以請Hsieh大大自行刪除比較不複雜且簡單的資料即可看出跟貼圖資料相同的內容
謝謝

Hsieh

回復 18# white5168
貼圖的資料並不是附件中CSV的資料
依照上述先進先出邏輯試著寫看看，你自己去比對看看結果正不正確

下載 (575.66 KB)

2012-5-1 17:07

1. Sub Get_Data()
   
2. Dim Ar(), Ay(), x, y
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. fs = ThisWorkbook.Path & "\DataBase.csv"
   
7. Open fs For Input As #1
   
8. Do Until EOF(1)
   
9.    Line Input #1, mystr
   
10.    a = Split(mystr, ",")
    
11.    If Val(a(0)) > 0 And Val(a(0)) <= [B1] Then
    
12.    If IsEmpty(d(a(1))) Then
    
13.        For i = 1 To Val(a(3))
    
14.           ReDim Preserve Ar(i)
    
15.           Ar(i - 1) = Val(a(2))
    
16.        Next
    
17.        If Val(a(3)) > 0 Then d(a(1)) = Ar
    
18.        Else
    
19.        Ar = d(a(1))
    
20.        s = UBound(Ar)
    
21.          For i = 1 To Val(a(3))
    
22.            ReDim Preserve Ar(s + i)
    
23.            Ar(s + i - 1) = Val(a(2))
    
24.          Next
    
25.        s = UBound(Ar)
    
26.          d(a(1)) = Ar
    
27.     End If
    
28.     If Val(a(4)) > 0 Then
    
29.        If IsEmpty(d1(a(1))) Then
    
30.        For i = 1 To Val(a(4))
    
31.           ReDim Preserve Ar(i)
    
32.           Ar(i - 1) = Val(a(2))
    
33.        Next
    
34.        If Val(a(4)) > 0 Then d1(a(1)) = Ar
    
35.        Else
    
36.        Ar = d1(a(1))
    
37.        s = UBound(Ar)
    
38.          For i = 1 To Val(a(4))
    
39.            ReDim Preserve Ar(s + i)
    
40.            Ar(s + i - 1) = Val(a(2))
    
41.          Next
    
42.          d1(a(1)) = Ar
    
43.     End If
    
44.     End If
    
45.     End If
    
46.    Erase Ay: Erase Ar
    
47. Loop
    
48. Close #1
    
49. For Each ky In d1.keys
    
50.    If IsArray(d1(ky)) Then Ar = d1(ky): x = UBound(Ar) Else x = 0 '出貨
    
51.    If IsArray(d(ky)) Then Ay = d(ky): y = UBound(Ay) Else y = 0 '進貨
    
52.    If x = 0 And y > 0 Then '只進不出
    
53.       For i = 0 To y - 1
    
54.         'sp = sp + Ar(i)
    
55.         bp = bp + Ay(i)
    
56.       Next
    
57.       bp = bp / y
    
58.       d2(ky) = Array(ky, y, 0, 0, Abs(y - x), y - x, Round(bp, 2), 0)
    
59.       bp = 0
    
60.       ElseIf y = 0 And x > 0 Then '只出不進
    
61.       For i = 0 To x - 1
    
62.         sp = sp + Ar(i)
    
63.       Next
    
64.       sp = sp / x
    
65.       d2(ky) = Array(ky, y, x, 0, 0, y - x, 0, Round(sp, 2))
    
66.       sp = 0
    
67.       ElseIf x > 0 And y > 0 Then
    
68.          If x > y Then '出大於進
    
69.          w = 0: w1 = y - x
    
70.          For i = 0 To y - 1
    
71.          pr = pr + Ar(i) - Ay(i)
    
72.          Next
    
73.          For j = i To x - 1
    
74.          nr = nr + Ar(i)
    
75.          Next
    
76.          nr = nr / (x - y) '不足量
    
77.          ElseIf x < y Then '進大於出
    
78.          w1 = 0: w = y - x
    
79.          For i = 0 To x - 1
    
80.          pr = pr + Ar(i) - Ay(i)
    
81.          Next
    
82.          For j = i To y - 1
    
83.          sr = sr + Ay(i)
    
84.          Next
    
85.          sr = sr / Abs(x - y) '不足量
    
86.          End If
    
87.          
    
88.          d2(ky) = Array(ky, y, x, pr, w, w1, Round(sr, 2), Round(nr, 2))
    
89.          pr = 0: nr = 0: sr = 0
    
90.    End If
    
91.    Erase Ay: Erase Ar
    
92. Next
    
93. [A4:H65536] = ""
    
94. [A4].Resize(d2.Count, 8) = Application.Transpose(Application.Transpose(d2.items))
    
95. End Sub

複製代碼

white5168

如圖分別為資料與最後資料
最後資料的部份對於日期是可調整的,如日期變動,則最後資料所呈現的畫面也會改變
相關的Excel檔在附件中,如有不清楚的請再提出發問
小弟比較不清楚各位所需的資訊到何種程度?所以如有冒犯請多多見諒