麻辣家族討論版版 - Powered by Discuz! Board

Option Explicit
Dim Rng As Range, AR()
Sub Main()
AR = Array("到期月份", "履約價", "買賣權", "成交量", "未沖銷契約量")
With Sheets("選擇權總表")
.[L4:M4] = Array("成交量", "未沖銷契約量") '"*成交量" ,"*未沖銷'資料庫欄"*" 進階篩選有會有錯誤
Set Rng = .Range("B4:Q" & .[B4].End(xlDown).Row) '資料庫
篩選程式 "分類一"
篩選程式 "賣權"
篩選程式 "買權"
.Activate
End With
End Sub
Private Sub 篩選程式(Sh As String) 'SH參數為字串型態 :工作表名稱
Dim T As String
With Sheets(Sh)
.Cells.Clear '儲存格:清除
.[L1].Value = AR(0) '進階篩選: CriteriaRange,準則欄位名稱("到期月份")
.[A1:E1].Value = AR '進階篩選: CopyToRange,複製到儲存格的欄位名稱
If Sh = "賣權" Or Sh = "買權" Then
.[L1].Value = AR(2) '進階篩選: CriteriaRange,準則欄位名稱("買賣權")
.[L2] = IIf(Sh = "買權", "Call", "Put") '進階篩選:準則欄位設立條件
End If
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.[L1:L2], CopyToRange:=.[A1:E1], Unique:=True
.[L1:L2] = "" 'Unique:=True 僅篩選唯一的記錄
If Sh <> "賣權" And Sh <> "買權" Then
.Rows(2).Delete '資料庫第2列為 (週別) 不需要刪掉
Else
月份契約篩選程式 Sh
End If
End With
End Sub
Private Sub 月份契約篩選程式(Sh As String)
Dim R As Range
On Error GoTo ER: '程式錯誤處裡:月份契約買權的工作表,如不存在會有錯誤.
With Sheets(Sh)
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
'篩選 [到期月份]在工作表最右端的欄位
For Each R In .Range(.Cells(2, .Columns.Count), .Cells(2, .Columns.Count).End(xlDown)) '最右端的欄位的[到期月份]
.Range("A1").AutoFilter Field:=1, Criteria1:=R '自動篩選: A欄準則= [到期月份]
.Range("A:E").Copy Sheets(R & Sh).[A1] '不符合準則的資料會隱藏掉
Next
End With
Exit Sub '離開這程序
ER:
If Err.Number = 9 Then '月份契約買權的工作表
Sheets.Add Sheets(Sheets.Count) '新增工作表
ActiveSheet.Name = R & Sh '工作表:命名
Resume '回到程式錯誤點
End If
MsgBox Err.Description & Err.Number '告知:不是工作表不存在會有錯誤.
End Sub

複製代碼

.[L4] ="成交量"
.[M4]= "未沖銷契約量")

複製代碼

AdvancedFilter 方法 [進階篩選]
請參閱套用至範例特定基於準則範圍從資料清單中篩選或複製資料。如果初始選定為單個儲存格，則使用儲存格目前的區域x為Variant。
expression.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
expression 必選。該運算式會傳回 [套用於] 清單中的其中一個物件。
Action 必選的 XlFilterAction 資料類型。
XlFilterAction 可以是這些 XlFilterAction 常數之一。xlFilterCopy ,xlFilterInPlace.
CriteriaRange 選擇性的 Variant。準則範圍。如果省略此引數則無準則。
CopyToRange 選擇性的 Variant。如果 Action 為 xlFilterCopy，此引數指定被複製列的目標範圍。否則忽略此引數。
Unique 選擇性的 Variant。若為 True，則僅篩選唯一的記錄；若為 False，則篩選出所有符合準則的記錄。預設值為 False。

複製代碼