返回列表 上一主題 發帖

[發問] ●(發問)大量資料連續新增欄位去計算的值的問題

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-1-7 16:03 | 只看該作者

[發問] ●(發問)大量資料連續新增欄位去計算的值的問題

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

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

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

分類好的數據附檔如下：
2011_01.rar (512.4 KB)

資料說明：

我們以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

資料夾圖1到2.rar (634.82 KB)

資料夾圖3到4.rar (635.06 KB)

資料夾圖5.rar (362.35 KB)

資料夾圖5.rar (362.35 KB)

收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼

TOP

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
3#
發表於 2012-1-8 14:24 | 只看該作者
回復 2# GBKEE

謝謝GBKEE大，

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

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 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
複製代碼

TOP

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
5#
發表於 2012-1-8 16:22 | 只看該作者
回復 4# GBKEE
謝謝GBKEE大 ，找到幾個影片教學，先來練看看，小弟沒灌VB，要找人看看有沒有光碟。

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
返回列表 上一主題