エクセル VBAに関する質問です。オートフィルタと同様のインターフェースをつくった事例はあるでしょうか? なぜこんなことするかというとどんな条件でオートフィルタをかけたかの記録をとりたいのです。もし事例がないとするとどうするのがいいのでしょうか? ヒントになるページなどありましたら教えてください。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:
  • 終了:2009/10/25 08:45:02
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

回答1件)

id:maruyama2 No.1

回答回数4ベストアンサー獲得回数1

ポイント60pt

'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

  • id:SALINGER
    既存のオートフィルタ機能から取得して変化を記録するものを考えてみたけど、
    何故か、「上位10項目」とかの「10」が取得できない・・・。
    「昇順」「降順」も取得できないしな。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません