標題: [發問] ●(發問)大量資料連續新增欄位去計算的值的問題 [打印本頁]

---

作者: yagami12th    時間: 2012-1-7 16:03     標題: ●(發問)大量資料連續新增欄位去計算的值的問題

本帖最後由 yagami12th 於 2012-1-8 12:05 編輯

一直無法夾帶檔案貼到文章裡面，試了好幾次，有人知道原因嗎

請教一個大量資料連續新增欄位計算的問題，在GBKEE大的幫忙下，數據分類好了之後，資料狀況如圖1到圖4所示：

分類好的數據附檔如下：
[attach]9139[/attach]

資料說明：

我們以2011/1月為例，裡面有2011_01_c跟2011_01_p兩個資料夾，這兩個資料夾裡面分別有34個excel檔案，在2011_01_c裡頭有2011_01_6900_c.xls到2011_01_10400_c.xls(共34個檔案)，2011_01_p的資料夾裡也是一樣有34個excel檔(同2011_01_c)
如圖1到圖4所示：


圖一：

圖二：

圖三：

圖四：
-------------------------------------------------------------------------------------------
以2011_01_c裡頭的2011_01_6900_c.xls為例：

步驟1(要計算的東西)：
我先在o1欄位新增字串"高價減低價"之後o2計算公式為g2-h2，計算完畢往下複製
再到p1欄位新增字串"成交量變化"(因為要算變化量，所以從p3欄開始才有計算結果，p2欄為空白)，p3欄=j3-j2之後往下複製
完成存檔，關閉檔案，再開2011_01_7000_c.xls，同樣在o1欄新增字串"高價減低價"跟p1欄新增字串"成交量變化"，之後的計算同上，
完成存檔，關閉檔案，再開2011_01_7100_c.xls，一直做到2011_01_10400_c.xls(2011_01資料夾裡的最後一個檔案)，結束。

步驟2：
接著開2011_01_p資料夾，再計算2011_01_6900_p.xls到2011_01_10400_p.xls(計算方式同上)，結束。

步驟3：
由於2011_01裡的2011_01_c(裡頭34個excel在上面已計算完畢)，2011_01_p(裡頭34個excel在上面也已計算完畢)，結束
接著開2011_02的資料，再計算完2011_02_c跟2011_02_p的資料夾裡面的各30幾個excel檔，存檔完畢後，再接著做2011_03的資料一直做到2011_12(要計算的東西同步驟1)
----------------------------------------------------------------------------------------------
步驟1 計算結果的範例(數字是隨便打的，因為排版一直無法完成：(只要計算最右邊兩個欄位的資料)(註：加註顏色會跑掉排版所以沒加註顏色)
|    A1             |-----|    F1   |  最高價(F1) | 最低價(G1)  |  H1    |成交量(J1)         |  高價減低價(O1)  |  成交量變化(P1) |
|2010/12/16  |-----|    F2   |  100            |  20               |  H2    |2000                 |  80                        |                           |
|2010/12/17  |-----|    F3   |  200            |  10               |  H2    |11000                 |  190                      |    9000              |
．．
．．
2010/1/19                                                                                                    

---------------------------------------------------------------------------------------
補充說明，圖五：

[attach]9122[/attach]

------------------------------------------------------------------------------------------------

我用巨集錄製的檔案，儲存格的指定方式用錄的會變的怪怪的，因為資料比較多，所以想向各位請教，先謝謝了。
程式碼如下：

Sub 巨集1()

    ChDir "C:\Users\user\Desktop\選擇權資料，按年份月份整理\2011選擇權整理完畢\2011_01\2011_01_C"
    Workbooks.Open Filename:= _
        "C:\Users\user\Desktop\選擇權資料，按年份月份整理\2011選擇權整理完畢\2011_01\2011_01_C\2011_01_6900_C.xlsx" '這裡是開啟指定的檔案
    Range("O1").Select                              '是指在Range(a1)的欄位貼上嗎？不太確定
     With Selection                                  '從這行到第13行都看不懂，但感覺不太重要
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
     End With
   
    ActiveCell.FormulaR1C1 = "高價減低價"            '在英文字母 O1欄位(不是零1)輸入字串"高價減低價"，不知道為什麼會變成R1C1這種指定格式，用cell(1,15)比較容易理解
    Range("O2").Select                               '點選O2(英文字母O2)欄位
    ActiveCell.FormulaR1C1 = "=RC[-8]-RC[-7]"        '然後在O2欄位=g2-h2
    Range("O2").Select
    Selection.AutoFill Destination:=Range("O2:O26") '算好結果複製到O2到O26
    Range("O2:O26").Select
    Range("P1").Select                               '再點選P1欄位
     With Selection                                  '從這行到  .MergeCells=Flase 看不懂
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
    ActiveCell.FormulaR1C1 = "成交量變化"          '在英文字母 p2欄位輸入字串"成交量變化"，不知道為什麼會變成R1C1這種指定格式，用cell(1,16)比較容易理解
    Range("P3").Select
    ActiveCell.FormulaR1C1 = "=RC[-6]-R[-1]C[-6]" '在p3格位輸入公式=j3-j2
    Range("P3").Select                             '停在p3欄位
    Selection.AutoFill Destination:=Range("P3:P26") '將p3格位計算結果複製到p26欄位
    Range("P3:P26").Select                         '視窗框在p3:p26停住
    ActiveWorkbook.Save                            '存檔
    ActiveWindow.Close                             '關檔
   
   
   
    Workbooks.Open Filename:= _
        "C:\Users\user\Desktop\選擇權資料，按年份月份整理\2011選擇權整理完畢\2011_01\2011_01_C\2011_01_7000_C.xlsx"  '繼續開2011_01_7000_C.xlsx的檔案，同上所述，繼續做
    Range("O1").Select
   
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
    ActiveCell.FormulaR1C1 = "高價減低價"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=RC[-8]-RC[-7]"
    Range("O2").Select
    Selection.AutoFill Destination:=Range("O2:O26")
    Range("O2:O26").Select
    Range("P1").Select
   
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
    ActiveCell.FormulaR1C1 = "成交量變化"
    Range("P3").Select
    ActiveCell.FormulaR1C1 = "=RC[-6]-R[-1]C[-6]"
    Range("P3").Select
    Selection.AutoFill Destination:=Range("P3:P26")
    Range("P3:P26").Select
    ActiveWorkbook.Save
    ActiveWindow.Close

End Sub

---

作者: GBKEE    時間: 2012-1-8 13:13

本帖最後由 GBKEE 於 2012-1-8 13:16 編輯

回復 1# yagami12th

->   用你這裡發文的檔案  執行此程式

1. Const ThePath = "d:\You\" '指定存放的主資料夾
   
2. Sub Ex()
   
3. Dim d As Object, SavePath As String, Sh As Worksheet, R As Variant, E As Variant, Newbook As Workbook
   
4. Dim MonPath As String, 選擇權 As String, 履約價 As String
   
5. Application.DisplayAlerts = False '停止系統 的提示
   
6. Application.ScreenUpdating = False '停止螢幕更新功能
   
7. Set d = CreateObject("scripting.Dictionary") '建立字典物件
   
8. SavePath = Dir(ThePath, 16) '傳回指定存放的主資料夾
   
9. If SavePath = "" Then MkDir (ThePath) '如主資料夾不存在 建立它
   
10. For Each Sh In Sheets
    
11. d.RemoveAll '字典物件 清空子物件
    
12. With Sh '依序處裡 每一工作表
    
13. For Each R In .Range(.[D2], .[D2].End(xlDown)) '每一工作表中在d欄
    
14. d(R.Value) = "" '字典物件 設立子物件(履約價)
    
15. Next
    
16. MonPath = Mid(.[c2], 1, 4) & "_" & Mid(.[c2], 5) '月資料夾
    
17. SavePath = Dir(ThePath & MonPath, 16) '尋找月資料夾
    
18. If SavePath = "" Then MkDir (ThePath & MonPath) '如月資料夾不存在 建立它
    
19. For Each E In Array("買權", "賣權") '依選擇權
    
20. 選擇權 = "\" & MonPath & IIf(E = "買權", "_C\", "_P\") '月資料夾\選擇權資料夾
    
21. SavePath = Dir(ThePath & MonPath & 選擇權, 16)
    
22. If SavePath = "" Then MkDir (ThePath & MonPath & 選擇權)
    
23. For Each R In d.KEYS '字典物件 依序處裡子物件 R (履約價)
    
24. .AutoFilterMode = False '工作表中取消自動篩選
    
25. .Range("A1").AutoFilter Field:=4, Criteria1:=R
    
26. .Range("A1").AutoFilter Field:=5, Criteria1:=E
    
27. 'AutoFilter 方法[自動篩選] 篩選出一個清單。
    
28. 'Field:=4 第4欄 (履約價) ,Criteria1:=R 準則=R (履約價)
    
29. 'Field:=5 第5欄 (選擇權) ,Criteria1:=E 準則=E (選擇權)
    
30. 履約價 = Mid(.[c2], 1, 4) & "_" & Mid(.[c2], 5) & "_" & R & IIf(E = "買權", "_C", "_P")
    
31. SavePath = ThePath & MonPath & 選擇權 & 履約價 '存檔的完整路徑名稱
    
32. Set Newbook = Workbooks.Add(1) '新開檔案(1頁)
    
33. .UsedRange.SpecialCells(xlCellTypeConstants).Copy Newbook.Sheets(1).[a1]
    
34. '自動篩選的資料 複製到新開檔案第1頁的.[a1]
    
35. With Newbook.Sheets(1)
    
36. .[O1] = "高價減低價"
    
37. .[P1] = "成交量變化"
    
38. With .[O2].Resize(.UsedRange.Columns(1).Rows.Count - 1) '在這範圍
    
39. .Cells = "=RC[-8]-RC[-7]" '然後在O2欄位=g2-h2: 制訂公式
    
40. .Value = .Value '取值 -> 消除公式
    
41. End With
    
42. With .[P3].Resize(.UsedRange.Columns(1).Rows.Count - 2)
    
43. .Cells = "=RC[-6]-R[-1]C[-6]" '在p3格位輸入公式=j3-j2
    
44. .Value = .Value
    
45. End With
    
46. End With
    
47. Newbook.Close True, SavePath '新開檔案關閉 存檔
    
48. Next
    
49. Next
    
50. .AutoFilterMode = False '離開工作表恢復原狀
    
51. End With
    
52. Next
    
53. Application.DisplayAlerts = True '恢復系統的提示
    
54. Application.ScreenUpdating = True '螢幕更新功能是開啟的則為 True。
    
55. MsgBox "工作完成"
    
56. End Sub

複製代碼

---

作者: yagami12th    時間: 2012-1-8 14:24

回復 2# GBKEE

謝謝GBKEE大，

發現我只會簡單的判斷式跟簡單的迴圈(如在版上發的"銷售管理範例")，跟一些版大分享的小技巧，還有錄製好巨集再回去編輯，再簡化成一層迴圈，不知道為什麼？看到兩層以上的迴圈就會開始不懂，兩層以上涵數應用也是同樣的情況。

想請教像字典元件一些用在大量資料篩選跟整理的一些進階程式碼，我從圖書館借來的書沒有這個部份，想請教GBKEE大有什麼推薦的教學跟書嗎？
如果想像大大程式一樣這麼強的話，能不能請大大分享一些學習的經驗。

---

作者: GBKEE    時間: 2012-1-8 15:23

回復 3# yagami12th
台語俚語 : 戲棚下站久是你的
我沒什麼經驗,功力是在這裡練習的 (多看多問多練習)

1. Sub Ex()
   
2.     Dim D As Object, AR(), E As Variant
   
3.     Set D = CreateObject("SCRIPTING.DICTIONARY")
   
4.     AR = Array("AA", "BB", "CC", "DD")
   
5.     For Each E In AR
   
6.         D(Mid(E, 1, 1)) = E
   
7.     Next
   
8.     For Each E In D.KEYS
   
9.         MsgBox E
   
10.     Next
    
11.     MsgBox Join(D.KEYS, ":")
    
12.     For Each E In D.ItemS
    
13.         MsgBox E
    
14.     Next
    
15.     MsgBox Join(D.ItemS, ":")
    
16. End Sub

複製代碼

[attach]9145[/attach]

---

作者: yagami12th    時間: 2012-1-8 16:22

回復 4# GBKEE
謝謝GBKEE大 ，找到幾個影片教學，先來練看看，小弟沒灌VB，要找人看看有沒有光碟。

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)