- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2012-1-5 14:43
| 只看該作者
回復 1# yagami12th - 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 Sheets '工作表1,工作表2,工作表3
- 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
- With Sheets.Add(Sheets(1)) '新增工作表
- .[A1].Resize(UBound(AR, 2), UBound(AR)) = Application.WorksheetFunction.Transpose(AR)
- .Cells.EntireColumn.AutoFit
- End With
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2012-1-5 12:19
| 
