'2種類、ご参考にしてみてください
'
'1:現在のフィルタ条件を見る
'2:条件をセル範囲に準備してフィルタします
'http://msdn.microsoft.com/ja-jp/library/microsoft.office.interop...(office.11).aspx
'
Sub a現在のフィルタ条件を見る()
'オートフィルターで、条件選択した状態で、行ってください。
'エラーが出ますが、参考にして下さい
フィルタ数 = ActiveSheet.AutoFilter.Filters.Count
For Each フィルタ In ActiveSheet.AutoFilter.Filters
フィルタ1 = ""
フィルタ2 = ""
If フィルタ.On Then
フィルタ1 = フィルタ.Criteria1
If フィルタ.Operator <> 0 Then
オペレタ = フィルタ.Operator
フィルタ2 = フィルタ.Criteria2
End If
End If
c = c + 1
msg = msg & c & "フィルタ条件 1: " & フィルタ1 & " " & オペレタ & " 2: " & フィルタ2 & vbCrLf
Next フィルタ
MsgBox msg, , "d現在のフィルタ条件を見る"
'Range("g1").Value = msg
End Sub
'
'
Sub bフィルタ()
'条件をセル範囲に準備してフィルタします
'
'検索条件範囲の設定方法は、HELPの
'「詳細な検索条件を指定してリストのデータを抽出する」にあります。
MsgBox "まず Sub dサンプルデータsetup()で、データを作ってください。"
If Not (ActiveCell.Column = Range("G:G").Column And ActiveCell.Value <> "") Then
MsgBox "G列の条件番号のセルを選択してください", , "G列選択!"
Exit Sub
End If
'
条件 = ActiveCell.Value
Dim 検索条件範囲 As Range, データ範囲 As Range
' 検索条件範囲(行方向は、「OR」、列方向は、「and」 )
Set 検索条件範囲 = ActiveCell.CurrentRegion
' データ範囲
Set データ範囲 = Range("A1").CurrentRegion
' フィルタの実行
データ範囲.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=検索条件範囲, Unique:=False
'
Set データ範囲 = Nothing
Set 検索条件範囲 = Nothing
'
MsgBox "条件 " & 条件 & " でフィルターしました", , " bフィルタ"
'
End Sub
'
'
Sub cフィルタ解除()
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
End Sub
'
'
Sub dサンプルデータsetup()
MsgBox "とりあえず保存してください", , "dサンプルデータsetup"
Set NewBook = Workbooks.Add
Do
fName = Application.GetSaveAsFilename("test1.xls", ",*.xls")
Loop Until fName <> False
NewBook.SaveAs Filename:=fName
Open ActiveWorkbook.Path & "\tmpcsv.csv" For Output As #1
Print #1, "No,氏名,性別,身長,年齢,,,,"
Print #1, "1,a山,男,140,10,,,,"
Print #1, "2,b山,男,145,18,,,,"
Print #1, "3,c山,女,150,26,,,,"
Print #1, "4,山c,女,155,34,,,,"
Print #1, "5,e山,男,160,42,,,,"
Print #1, "6,丸fc,女,165,50,,,,"
Print #1, "7,丸g,男,170,58,,,,"
Print #1, "8,h丸,男,175,66,,,,"
Print #1, "9,ic丸,女,180,74,,,,"
Print #1, ""
Print #1, "No,氏名,性別,身長,年齢,,条件,氏名,"
Print #1, "1,a山,男,140,10,,1,*山*,"
Print #1, "2,b山,男,145,18,,,,"
Print #1, "3,c山,女,150,26,,条件,氏名,性別"
Print #1, "4,山c,女,155,34,,2,*c*,女"
Print #1, "5,e山,男,160,42,,,,,"
Print #1, "6,丸fc,女,165,50,,条件,氏名,性別,身長"
Print #1, "7,丸g,男,170,58,,3,*c*,女,>=165"
Print #1, "8,h丸,男,175,66,,,,,"
Print #1, "9,ic丸,女,180,74,,条件,年齢,,"
Print #1, ",,,,,,4,<=20,,"
Print #1, ",,,,,,,>=60,,"
Print #1, ""
Print #1, ",,,,,,条件,年齢,性別,"
Print #1, ",,,,,,5,<=20,男,"
Print #1, ",,,,,,,>=60,女,"
Print #1, ""
Print #1, ",,,,,,条件,年齢,年齢,"
Print #1, ",,,,,,6,>=30,<=50,"
Close #1
Workbooks.Open Filename:=ActiveWorkbook.Path & "\tmpcsv.csv"
Range("G13").Select
MsgBox "マクロの 「bフィルタ」を実行してください", , "OK"
End Sub
コメント(1件)
何故か、「上位10項目」とかの「10」が取得できない・・・。
「昇順」「降順」も取得できないしな。