123
返回列表 上一主題 發帖

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

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-4-28 14:06 | 只看該作者

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

FIFO
個問大大如題
請問如何用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

test.rar (612 Bytes)

產品買賣資料明細

收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
277  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
26#
發表於 2012-5-2 11:56 | 只看該作者
回復 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檔案

  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
複製代碼
學海無涯_不恥下問

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
25#
發表於 2012-5-2 09:09 | 只看該作者
回復 25# white5168

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

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

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

TOP

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
24#
發表於 2012-5-1 23:58 | 只看該作者
本帖最後由 white5168 於 2012-5-2 00:22 編輯

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

TOP

wang

帖子
12 
主題
0 
精華
0 
積分
108 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
註冊時間
2010-5-23 
最後登錄
2020-11-16 
23#
發表於 2012-5-1 22:43 | 只看該作者
本帖最後由 wang 於 2012-5-2 21:20 編輯

對不起  會錯意  自刪

TOP

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
22#
發表於 2012-5-1 17:46 | 只看該作者
本帖最後由 white5168 於 2012-5-1 17:58 編輯

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

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

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
277  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
21#
發表於 2012-5-1 17:35 | 只看該作者
回復 20# white5168
我並非科班出身，只懂一點VBA皮毛，其他程式不懂
至於您所謂模組化，我並不了解其義
如果您確定貼圖資料是正確，那我的程式碼跑出來結果就必然是錯的
必須再來看看哪邊出問題了
學海無涯_不恥下問

TOP

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
20#
發表於 2012-5-1 17:26 | 只看該作者
很感謝Hsieh大大幫忙,不過目前我還無法下載所有大大所回覆的附件,只能等到升級後才能看到結果
想請問Hsieh大大, Excel VBA的程式,是否能做到跟C,C++等高階語言一樣模組化的程度?
這裡我要澄清說明,附件的原始資料的確是貼圖的資料,我只是將原始資料中比較簡單的不複雜的資料項剔除
貼圖的資料是我將原始資料留下複雜的部份來做說明用的
在撰寫程式的過程中會遇到問題的資料,基本上程式撰寫只要複雜的能寫的出來,其他的都不成問題
可以請Hsieh大大自行刪除比較不複雜且簡單的資料即可看出跟貼圖資料相同的內容
謝謝

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
277  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
19#
發表於 2012-5-1 17:07 | 只看該作者
回復 18# white5168
貼圖的資料並不是附件中CSV的資料
依照上述先進先出邏輯試著寫看看，你自己去比對看看結果正不正確
play.gif
  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
複製代碼
學海無涯_不恥下問

TOP

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
18#
發表於 2012-4-30 15:06 | 只看該作者
本帖最後由 white5168 於 2012-4-30 15:15 編輯

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

source.JPG (147.79 KB)

資料

source.JPG

finalscreen.JPG (120.04 KB)

呈現畫面

finalscreen.JPG

test.rar (2.85 KB)

TOP

        靜思自在 : 得理要饒人，理直要氣和。
123
返回列表 上一主題