Hsieh

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

white5168

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

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

wang

對不起  會錯意  自刪

white5168

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

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

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

複製代碼