- 帖子
- 88
- 主題
- 13
- 精華
- 0
- 積分
- 104
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- OFFICE2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-1-3
- 最後登錄
- 2017-12-31
|
[發問] ★請教各位 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)
|
|
發表於 2012-1-3 10:17
| 
發表於 2012-1-4 21:24
| 
