- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2012-1-6 08:55 編輯
回復 13# yagami12th
7#檔案(須刪除工作表3 第一列) 測試 ok ,你試試看. 如不行試試 修改的程式碼- Option Explicit
- Sub Ex()
- Dim E As Worksheet, i As Date, M As Variant, AR(), C As Variant
- ReDim AR(1 To 5, 1 To 1) '第一維 有5個元素 ,第二維 有1個元素
- AR(1, 1) = "日期"
- AR(2, 1) = "買權 最大未倉量"
- AR(3, 1) = "買權 最大未平倉量落在哪個履約價"
- AR(4, 1) = "賣權 最大未倉量"
- AR(5, 1) = "賣權 最大未平倉量落在哪個履約價-"
- Application.ScreenUpdating = False
- For Each E In ActiveWorkbook.Sheets '作用中的活頁簿中的 工作表
- If E.FilterMode Then E.AutoFilterMode = False '有篩選時 取消[篩選]
- For i = E.[a2] To E.[a2].End(xlDown) '日期[A2]直到最後的日期
- E.AutoFilterMode = False
- E.Range("A1").AutoFilter 1, i
- If E.Range("A1").End(xlDown).Row <> Rows.Count Then '因中間有沒交易日期[篩選]不到資料
- ReDim Preserve AR(1 To 5, 1 To UBound(AR, 2) + 1) '第二維 原有元素再加1元素
- AR(1, UBound(AR, 2)) = i '日期: i
- For Each C In Array("買權", "賣權")
- E.AutoFilterMode = False
- E.Range("A1").AutoFilter 1, i
- E.Range("A1").AutoFilter 5, C
- M = Application.Max(E.Range("L:L").SpecialCells(xlCellTypeVisible))
- AR(IIf(C = "買權", 2, 4), UBound(AR, 2)) = M '最大未倉量
- 'IIf(C = "買權", 2, 4) C = "買權"->2 ,C <> "買權"-> 4
- Set M = E.Range("L:L").SpecialCells(xlCellTypeVisible).Find(M, LookIn:=xlValues)
- AR(IIf(C = "買權", 3, 5), UBound(AR, 2)) = M.Offset(, -8) '最大未平倉量落在哪個履約價
- Next
- End If
- Next
- Next
- Dim SaveName As String
- With ActiveWorkbook '作用中的活頁簿
- SaveName = .Path & "\" & Format(.Sheets(1).[a2], "yyyy") & "年選擇權.xls" '存檔路徑名稱
- End With
- With Workbooks.Add(1).Sheets(1) '新增活頁簿 [存放整理的資料]
- .[A1].Resize(UBound(AR, 2), UBound(AR)) = Application.WorksheetFunction.Transpose(AR)
- .Cells.EntireColumn.AutoFit
- .Parent.SaveAs SaveName '新增活頁簿存檔
- End With
- Application.ScreenUpdating = True
-
- End Sub
|
|
發表於 2012-1-5 14:43
| 
