返回列表 上一主題 發帖

[發問] ★請教各位 vba整理數據問題,根據條件,開特定新檔,貼檔,儲存,再條件判斷的問題

回復 1# yagami12th
檔案中只需處裡 工作表1,工作表2,工作表3, 不需要{選擇權整理格式] [2011_1_6900]
  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, Field:=5, Criteria1:=E
  26.                      'AutoFilter 方法[自動篩選] 篩選出一個清單。
  27.                      'Field:=4 第4欄 (履約價) ,Criteria1:=R 準則=R (履約價)
  28.                      'Field:=5 第5欄 (選擇權) ,Criteria1:=E 準則=E (選擇權)
  29.                     履約價 = Mid(.[c2], 1, 4) & "_" & Mid(.[c2], 5) & "_" & R & IIf(E = "買權", "_C", "_P")
  30.                     SavePath = ThePath & MonPath & 選擇權 & 履約價  '存檔的完整路徑名稱
  31.                     Set Newbook = Workbooks.Add(1)                  '新開檔案(1頁)
  32.                     .UsedRange.SpecialCells(xlCellTypeConstants).Copy Newbook.Sheets(1).[a1]
  33.                     '自動篩選的資料 複製到新開檔案第1頁的.[a1]
  34.                     Newbook.Close True, SavePath                    '新開檔案關閉 存檔
  35.                 Next
  36.             Next
  37.             .AutoFilterMode = False                                 '離開工作表恢復原狀
  38.         End With
  39.     Next
  40.     Application.DisplayAlerts = True                                '恢復系統的提示
  41.     Application.ScreenUpdating = True                               '螢幕更新功能是開啟的則為 True。
  42.     MsgBox "工作完成"
  43. End Sub
複製代碼

TOP

回復 5# yagami12th
在2011_01_C的資料夾,"所有的資料"該如何改才能 只留"買權"的資料,而2011_01_P 可以只留"賣權"的資料,
是什意思
給你的程式 :  C的資料夾不就是只有買權"的資料,P的資料夾不就是只有賣權"的資料

TOP

回復 8# yagami12th
更正5#    C的資料夾是"買權"跟"賣權"皆有,P的資料夾也是"買權"跟"賣權"皆有。
改這裡出錯  .Range("A1").AutoFilter Field:=4, Criteria1:=R, Field:=5, Criteria1:=E  要分為2個程式碼?
  1.                     .Range("A1").AutoFilter Field:=4, Criteria1:=R
  2.                     .Range("A1").AutoFilter Field:=5, Criteria1:=E
複製代碼

TOP

回復 9# yagami12th
2011_1月契約的開倉到結算是從2010/12/16到2011/1/19,並不是剛好的1/1到1/31,
你可以將所有的 期貨交易 資料皆置於一資料庫
迴圈條件 1.制訂開倉日期~結算日期, 2.履約價, 3.買賣權,  篩選資料

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題