返回列表 上一主題 發帖

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

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2012-4-29 23:32 | 顯示全部帖子
回復 14# white5168
原始資料
                    商品     價格   買進   賣出
20120401      A    2000   500         0
20120402      B     1500       0    100
20120403      A    2020   400         0
20120404      A    2050   400    200
20120405      A    2010        0    200

類先買進先賣出
20120404結算時, 20120401的A產品平均買進成本,需以當時剩餘來計算即(2000*500- 2050*200)/(500-200)=1966.67,數量剩為500-200=300,表示20120401當天交易數量還有剩300(這是我需要的)
依你以上敘述，20120404之前A產品共有3筆資料(20120401，A，2000，500，0)、(20120403，A，2020，400，0)、(20120404，A，2050，400，200)
既然先進先出20120404這筆賣出，應該是用20120401這個價位2000
那麼剩下的不是應該(2000*(500-200)+2020*400+2050*400)/(500+400+400-200)才是成本價位嗎?
這種專業的會計知識我一點都沒有，不知道我的理解與實務差別在哪?
建議您將想要顯示的結果直接用手算出後，填入想要實現的位置，並在隔壁欄位填入你計算的依據
這樣或許比較容易釐清所謂先進先出的概念。
學海無涯_不恥下問

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 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

Hsieh

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

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

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 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

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題