12
返回列表 上一主題 發帖

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

yagami12th

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

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

在下才剛學vba不久，由於問題一直解不出來，只能完成部份程式碼，所以來請教版上各位。       檔案如最後一行的附件：

程式碼簡述：
----------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub 完整去抓符合條件的資料不斷往下貼的雙迴圈用法()

  Worksheets("選擇權整理格式").Copy after:=Worksheets(Worksheets.Count) '將請款書原型sheet，複製到工作表3後面，.count就代表屬性設為.name
  Worksheets(Worksheets.Count).Name = "2011_1_6900" '將新增sheet的名稱設定為a公司，連續按f5會錯誤，因已設定名稱
  
  Dim i As Double ' 工作表1 用的計數器變數
  Dim x As Double ' 1月選擇權 工作表用的計數器變數
  Dim sheets1 As Range     '原始選擇權的工作表1表格的基準點
  Dim month1data As Range  '1月選擇權整理後 工作表 的基準點儲存格

x = 2 '設定好基準點就不用設為2，因1月選擇權 工作表是從第2列開始貼資料，將2放在x變數
  
  Set sheetsx = Worksheets("工作表1").Range("A2")
  Set month1data = Worksheets("2011_1_6900").Range("A2")

'將篩選的原始選擇權資料複製到 1月選擇權 工作表

For i = 1 To sheetsx.CurrentRegion.Rows.Count                     '從a2到最後一欄，宣告原始選擇權資料 列數的迴圈
  
    If Worksheets("工作表1").Cells(i, 4).Value = "6900" Then                       '如果履約價為6900則進行
  
  Worksheets("2011_1_6900").Cells(x, 1).Value = Worksheets("工作表1").Cells(i, 1).Value      '交易日期

  Worksheets("2011_1_6900").Cells(x, 2).Value = Worksheets("工作表1").Cells(i, 2).Value        '契約
  Worksheets("2011_1_6900").Cells(x, 3).Value = Worksheets("工作表1").Cells(i, 3).Value         '交割月份
  Worksheets("2011_1_6900").Cells(x, 4).Value = Worksheets("工作表1").Cells(i, 4).Value       '履約價
  Worksheets("2011_1_6900").Cells(x, 5).Value = Worksheets("工作表1").Cells(i, 5).Value       '買賣權
  Worksheets("2011_1_6900").Cells(x, 6).Value = Worksheets("工作表1").Cells(i, 6).Value       '開盤價
  Worksheets("2011_1_6900").Cells(x, 7).Value = Worksheets("工作表1").Cells(i, 7).Value       '最高價
  Worksheets("2011_1_6900").Cells(x, 8).Value = Worksheets("工作表1").Cells(i, 8).Value       '最低價
  Worksheets("2011_1_6900").Cells(x, 9).Value = Worksheets("工作表1").Cells(i, 9).Value       '收盤價
  Worksheets("2011_1_6900").Cells(x, 10).Value = Worksheets("工作表1").Cells(i, 10).Value   '成交量
  Worksheets("2011_1_6900").Cells(x, 11).Value = Worksheets("工作表1").Cells(i, 11).Value   '結算價
  Worksheets("2011_1_6900").Cells(x, 12).Value = Worksheets("工作表1").Cells(i, 12).Value   '未沖銷契約數
  Worksheets("2011_1_6900").Cells(x, 13).Value = Worksheets("工作表1").Cells(i, 13).Value   '最後買進價格
  Worksheets("2011_1_6900").Cells(x, 14).Value = Worksheets("工作表1").Cells(i, 14).Value   '最後賣出價格
  
x = x + 1                   '讓1月選擇權工作表工作表的複製位置向下移動一列
    End If
Next i
End Sub
-----------------------------------------------------------------------------------------------------------------------------

說明：工作表1為2011年1月選擇權契約，2011_6900工作表為我寫程式後整理好的資料結果

上面這段程式碼可以把"工作表1"裡 篩選出 履約價為"6900"的一整列 複製出來，貼到我新增的工作表。

但是問題1為：我現在只能把有"6900"的資料抓出來，但是我還有7000，7100．．．到10200，這樣會太多。

問題2為：我只能做到用程式篩選出我要的資料，貼到指定的工作表。
「但我想做的是1 程式掃到"6900"&"買權"」
                       2 馬上開一個新excel 檔名為： 2011_1_6900_C.xls
                      3 把原工作表篩選出符合"6900"&"買權"條件的列資料全部複製，貼到                     
                         2011_1_6900_C.xls
                      4 將2011_1_6900_C.xls 儲存，關檔
                      5 程式又掃到"7000"&"買權"
                      6 馬上開一個新excel 檔名為： 2011_1_7000_C.xls
                      7 同步驟3和4
                      8  繼續掃7100到10200，與上述做法相同
最後會新增產生2011_1_6900_C.xls 到2011_1_10200_C.xls，共有五十個xls檔左右
另外還有賣權的資料也需要整理出來，所以還有 2011_1_6900_P.xls 到2011_1_10200_P.xls 也大概五十個xls檔左右

結果為2011_1的資料夾裡會有2011_1_c跟2011_1_p兩個資料夾，2011_1_c資料夾裡有2011_1_6900_C.xls 到2011_1_10200_C.xls，共有五十個xls檔左右，2011_1_6900_p裡以此類推。
如此一來就完成2011年1月的資料整理，還有2月到12月．．．

試了很久無法成功才向大家請益。文章有點長，先謝謝各位了。

檔案如附件：
2011年近月選擇權.rar (326.36 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-3 13:45 | 只看該作者
回復 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

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
3#
發表於 2012-1-3 14:49 | 只看該作者
先趕緊回文感謝GBKEE大大，我先好好研究一下。

TOP

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
4#
發表於 2012-1-3 18:55 | 只看該作者
程式能完整執行，沒有問題，想再請教：

以2011_01資料夾為例，在2011_01_C的資料夾，"所有的資料"該如何改才能 只留"買權"的資料
，而2011_01_P 可以只留"賣權"的資料，因為C就是買權的意思，P就是賣權的意思，
不好意思，又再一次麻煩大大。
剛一直在GOOGLE 字典元件是什麼，還有很多地方要查。標注顏色是方便看，有時買跟賣會看不清楚。

以下為例子
原本格式：
----------------------------------------------------------------------
交易日期                             契約        交割月份        履約價        買賣權       
2010/12/16        TXO        201101        6900        買權       
2010/12/16        TXO        201101        6900        賣權       
2010/12/17        TXO        201101        6900        買權       
2010/12/17        TXO        201101        6900        賣權
．．
2011/1/19                    TXO        201101        6900        買權       
2010/1/19        TXO        201101        6900        賣權

-------------------------------------------------------------------------------
想變成2011_01_6900_C：
----------------------------------------------------------------------
交易日期                             契約        交割月份        履約價        買賣權       
2010/12/16        TXO        201101        6900        買權               
2010/12/17        TXO        201101        6900        買權       
．．
2011/1/19                    TXO        201101        6900        買權
---------------------------------------
跟：
2011_01_6900_P：
----------------------------------------------------------------------
交易日期                             契約        交割月份        履約價        買賣權       
2010/12/16        TXO        201101        6900        賣權               
2010/12/17        TXO        201101        6900        賣權
．．
2010/1/19        TXO        201101        6900        賣權
-------------------------------------------------------------------------
先謝謝了。

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2012-1-4 16:46 | 只看該作者
回復 5# yagami12th
在2011_01_C的資料夾，"所有的資料"該如何改才能 只留"買權"的資料，而2011_01_P 可以只留"賣權"的資料，
是什意思
給你的程式 :  C的資料夾不就是只有買權"的資料,P的資料夾不就是只有賣權"的資料

TOP

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
6#
發表於 2012-1-4 19:24 | 只看該作者
回GBKEE大：C的資料夾是"買權"跟"賣權"皆有，P的資料夾也是"買權"跟"賣權"皆有。

以下為例子，以6900履約價為例，2011_01裡面的2011_01_C，2011_01_P兩個資料夾的檔案都同時包含買權跟賣權，如格式1所示

格式1：
----------------------------------------------------------------------
交易日期                             契約        交割月份        履約價        買賣權        
2010/12/16        TXO        201101        6900        買權        
2010/12/16        TXO        201101        6900        賣權       
2010/12/17        TXO        201101        6900        買權        
2010/12/17        TXO        201101        6900        賣權
．．
2011/1/19                    TXO        201101        6900        買權       
2010/1/19        TXO        201101        6900        賣權

先謝謝了，程式碼還在研究，因為學VBA不久，都只會很基本的用法，現在開始進階了，用錄製的去編輯裡學好像不夠了，要好好研究迴圈，目前還找不到很多範例跟詳細註解的迴圈書，反而是很多日本人寫的VBA入門書，註解都很詳細，程式都能執行才能學到現在這一步，我很多同學都放棄學程式，他們覺得程式太難學，一直跳錯誤視窗學不下去。

TOP

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
7#
發表於 2012-1-4 19:32 | 只看該作者
所以想變成：(說明：C的意思是買權 ，P的意思是賣權，6900_C就是履約價在6900的買權。

另外，因為2011/1月的契約是從2010/12/16開始，2011_01_6900_C的意思為在2011年的1月開倉到結算，共27日左右的交易日裡面的每天，履約價在6900的買權的價格變化，所以才會變成以下格式所示，賣權以此類推)
想變成2011_01_6900_C：
----------------------------------------------------------------------
交易日期                             契約        交割月份        履約價        買賣權        
2010/12/16                          TXO        201101         6900           買權               
2010/12/17                          TXO        201101         6900           買權        
．．
2011/1/19                             TXO        201101        6900          買權
---------------------------------------
跟：
2011_01_6900_P：
----------------------------------------------------------------------
交易日期                             契約        交割月份        履約價        買賣權        
2010/12/16                         TXO        201101         6900           賣權               
2010/12/17                         TXO        201101         6900           賣權
 ．．
2010/1/19                           TXO        201101        6900            賣權
 -------------------------------------------------------------------------
先謝謝了。

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2012-1-4 20:47 | 只看該作者
回復 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

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
9#
發表於 2012-1-4 21:06 | 只看該作者
謝謝GBKEE大，我試一下可不可以順利運行。

以2011_1月契約為例：是從2010/12/16開始交易，但以6900的履約價來說，買權跟賣權需分開計算，簡單來說會去會去買進買權的人就是賭盤勢上漲，買進賣權的人就是賭盤勢會下跌，所以兩個東西意義不同，需分開計算。

選擇權資料有很多難以處理的部份，像2011_1月契約的開倉到結算是從2010/12/16到2011/1/19，並不是剛好的1/1到1/31，加上資料複雜，這樣資料的整理是比較複雜，除非是VBA高手才有辨法，像用MATLAB都不一定好整理。

前面因為選擇權資料包括近月跟遠月資料很亂，所謂近月是指當月，也就是上面舉的例子，遠月就是下個或下下個月份等等，上述資料是我用腦殘程式篩選出來，就當初沒辨法做到指定SHEET讀指定檔案，會變成一直開新EXCEL，加上不太會寫迴圈，就錄一錄，複製貼上程式碼弄個很多行就解決。有空我再獻醜，放上我的腦殘程式碼。

TOP

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
10#
發表於 2012-1-4 21:17 | 只看該作者
向GBKEE大 致敬，真的太強了，程式碼整理成功，太感謝了。我在繼續找excel範例練習，迴圈我蠻弱的雙層就開始昏了，不知這是否為正常現象。

經過這個範例才知道，要學的還很多，論壇上很多文章要研究。目前還找不到專門說明大量數據處理的excel書。

TOP

        靜思自在 : 稻穗結得越飽滿，越會往下垂，一個人越有成就，就要越有謙沖的胸襟。
12
返回列表 上一主題