[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『オートフィルタの追加or解除について』(サラダ)
初めまして。私はサラダと言います。 VBAでトグルボタンでのオートフィルタの制御について質問します。VBA制作依頼ではなく質問です。 ◎は、言葉だけの羅列では見づらいかなって思って作りました。●も◎も内容は同じです。
質問1 そもそもVBAでさらにトグルボタンでオートフィルタに、 一つの列であとから抽出を追加したり解除したりできますか?
質問2 IF文で塊ごと(例えばトマトで始まる内容を一まとめに一つのトグルボタン)で制作か、 それとも一行ごとに(トグルボタン×15個で)制作すべきですか?
「基本情報」 セル :C行 抽出用単語ボタン :トマト パセリ イチゴ ← トグルボタンを再度押すとその検索語のみ解除
● : 内容 トマトが選んだ後、何も選ばない場合、 =トマトのみ トマトを選んだ後、トマトを外した場合、 =抽出解除 トマトを選んだ後、パセリを選んだ場合、 =トマト&パセリ トマト&パセリ後、パセリを外した場合、 =トマトのみ トマトを選んだ後、イチゴを選んだ場合、 =トマト&イチゴ トマト&イチゴ後、イチゴを外した場合、 =トマトのみ
パセリが選んだ後、何も選ばない場合、 =パセリのみ パセリを選んだ後、パセリを外した場合、 =抽出解除 パセリ&トマト後、トマトを外した場合、 =パセリのみ パセリを選んだ後、イチゴを選んだ場合、 =パセリ&イチゴ パセリ&イチゴ後、イチゴを外した場合、 =パセリのみ
イチゴが選んだ後、何も選ばない場合、 =イチゴのみ イチゴを選んだ後、イチゴを外した場合、 =抽出解除 イチゴ&トマト後、トマトを外した場合、 =イチゴのみ イチゴ&パセリ後、パセリを外した場合、 =イチゴのみ
◎ : A=トマト B=パセリ C=イチゴ 0=何も選ばない(または抽出だけ解除) A + 0 = A A − A = 0 A + B = A&B A − B = A A + C = A&C A − C = A
B + 0 = B B − B = 0 B − A = B B + C = C&B B − C = B
C + 0 = C C − C = 0 C − A = C C − B = C
< 使用 Excel:Excel2016、使用 OS:Windows10 >
質問1 可能です。
質問2
トグルボタンの使用が前提なら、トグルボタン×15個作成(ToggleButton1〜15)し、
それぞれのCaptionをトマト、パセリ、イチゴ等にしておきます。
各ToggleButtonをクリックした時のClickイベントで、マクロをCallします。
[例] Call test
Sub test()
Dim i As Long Dim j As Long Dim s() As String Application.ScreenUpdating = False With Worksheets("Sheet1") If .AutoFilterMode = False Then .Range("A6").CurrentRegion.AutoFilter ElseIf .FilterMode = True Then .ShowAllData End If
For i = 1 To 4 With .OLEObjects("ToggleButton" & i).Object If .Value = True Then j = j + 1 ReDim Preserve s(1 To j) s(j) = .Caption End If End With Next
With Worksheets("Sheet1") If j = 0 Then If .FilterMode = True Then .ShowAllData Else .Range("A6").CurrentRegion.AutoFilter _ Field:=1, Criteria1:=s, _ Operator:=xlFilterValues End If End With End With Application.ScreenUpdating = True End Sub
Sheet1のA6からのデータにフィルタを掛けるとします。(A6は項目名)
一旦全データを表示してから再度フィルタリングします。
但し、何故トグルボタンなのか? 疑問です。
(ウッシ) 2017/02/21(火) 11:54
別案で、とこかのセル範囲に、対象文字列の一覧を作成しておき、例えば右クリックすると色が付き、再度右クリックだと消えるようにしてはいかがでしょう? これなら、C列丸ごとコピーした後、重複の削除機能で、あっというまに表を一新できますよ。
また、項目選択と実行ボタンで処理を分けるというのも良いのではないかと思います。
(???) 2017/02/21(火) 13:15
ウッシさん、ありがとうございます! なんでトグルボタンかというと、今どのような条件でフィルタがかかっているのかが 一目でわかるようにするためです。押されている状態ならそれが今現在の抽出条件ですし、 押されていなければ抽出されていないとわかるからです。 いちいちほかの空きセルにフィルタの状態を転機させるのもVBA書くの大変ですし、 という意味からトグルにしました。
質問1で、できると知り良かったです☆ ただ、質問2で、15個全部それぞれの条件用のトグルが必要になるんですね、、、。と 少し愕然としました。
とらいえず光は見えたので頑張ります! かいとうありがとうございました! (サラダ) 2017/02/21(火) 13:17
???さん(というお名前でいいのでしょうか?文字化けしてるのでしょうか???)、 ありがとうございました。 ただ、ごめんなさい、ちょっと意味が理解できなくて、 ふぉるたーかけている状態でさらにほかのセルに何か表記するのでしょうか? う〜ん、、、想像できない状態です^^; でも、ありがとうございました! (サラダ) 2017/02/21(火) 13:20
データのない行とか列ってありますよね? というか、そういう部分にボタンを置こうとしているはず。そのあたりのセル範囲を、トグルボタンの代わりにすると、16個目とか追加になっても簡単、という話です。ボタンを押した/押してない状態を、セルの色が付いている/付いていないに置き換えるだけ。
(???) 2017/02/21(火) 13:31
???さんありがとうございます! お名前の件、了解しました!
ところで、質問の件なのですが A6からD6の間に題名が下記のようにあります。 ほんとはD6以降もいろいろ数値がありますが、D6以降は空白セルがあるので 省きます。
鮮度番号 お名前 冷蔵庫番号 偉大さ番号 ←項目名は適当です>< でも間に空きはありません。 この鮮度番号〜横一列にオートフィルタがされています、
そしてA7から、今はD165まで情報が入っています。空白セルは生まれません。 そして最初に書いてあったトマトなどは冷蔵庫番号なのです。
トマトを選んだあと、やっぱりパセリも一緒に見たい、 よし!トマトとパセリを抽出だ! トマトボタンをポチっとなパセリボタンもポチっとな(それぞれのトグルボタンが凹)。 これでトマトとパセリの抽出状態になります。 あ、やっぱりトマトいいや。トマトボタンをポチっとな(トグルボタンだとこの時、ボタンが凸)。 するとこの時、パセリだけの抽出条件だけになるみたいな。。。
当初はトマト/パセリ/イチゴの3つのトグルボタンで何とかなるよねぇ、、、。 と思っていたんですがやはりそれぞれの抽出条件ごとに、 ボタン作成またはセル色作成ですかorz
やはり道は険しいですね。。。 (サラダ) 2017/02/21(火) 13:48
トグルボタンだと、オートフィルタを設定するマクロを書かないといけないだけで、できる事は同じだと思うのですが、オートフィルタの標準機能を直接使わないのは何故なのでしょうか?
(???) 2017/02/21(火) 13:56
実はこの質問の前段階で
トグルボタン1=トマトを押すと 他のボタンの抽出条件はクリアし M2セルに入っている文字も空白にして、 さらにほかのトグルボタンをへこんだ状態から戻して さらにさらに空白になったM2セルに"トマト"を入力し オートフィルタはトマトを抽出せよ! というVBAを組んでいました。ネットの中ら探して組み立ててみました。
なのでこの延長戦で3つのトグルボタンをそれぞれ3つのトグルボタンだけで 制御できないかなぁって思って質問しました。 しょうじきVBAの記述は全然思い浮かばなかったので まずはできるのかどうか聞いてみたかったんです><
ちなみに同じプログラムが二つあるのは、二つ書き込まないとなぜか、 他のトグルボタンが戻らなかったり M2に文字が入力またはクリアされなかったり トグルを凹から凸にしたとき抽出状態がクリアされなかったり、、 なんでこの形になりました><
Private Sub ToggleButton1_Click()
On Error Resume Next
Range("M2") = "トマト" With ToggleButton1 If .Value Then Range("D6").AutoFilter Field:=3, Criteria1:="トマト*" ToggleButton2.Value = False ToggleButton3.Value = False Range("M2") = "トマト" Else .Value = False ActiveSheet.ShowAllData Range("M2").ClearContents ActiveSheet.ShowAllData End If End With
With ToggleButton1 If .Value Then Range("D6").AutoFilter Field:=3, Criteria1:="トマト*" ToggleButton2.Value = False ToggleButton3.Value = False Range("M2") = "トマト" Else .Value = False ActiveSheet.ShowAllData Range("M2").ClearContents ActiveSheet.ShowAllData End If End With End Sub (サラダ) 2017/02/21(火) 14:06
あ!前段階のVBAはそれぞれのトグルボタンだけの抽出で、 現段階のやりたいVBAは、同時に押したときに使える感じです>< 意味が解らなかったらごめんなさい(汗 (サラダ) 2017/02/21(火) 14:17
テストブックで試して下さい。
A6からD6の間に題名
A7から、今はD165まで情報
冷蔵庫番号でフィルタリング
トグルボタンは無し
A4〜O4?まで選択肢
としてます。
Sheet1のシートタブを右クリックしコードの表示でイベントモジュールを追加します。
Private Sub Worksheet_Activate()
Dim r As Range Dim oDic As Object Set oDic = CreateObject("Scripting.Dictionary") With Range("C7", Range("C" & Rows.Count).End(xlUp)) For Each r In .Cells oDic(r.Value) = True Next End With With Range("A4").Resize(, oDic.Count) .Value = oDic.keys .Interior.ThemeColor = xlThemeColorAccent3 End With With Me If .AutoFilterMode = False Then .Range("A6").CurrentRegion.AutoFilter ElseIf .FilterMode = True Then .ShowAllData End If End With End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim t As Range With Me On Error Resume Next Set t = .Range("A4").Resize(, WorksheetFunction.CountA(.Rows(4))) On Error GoTo 0 If t Is Nothing Then Exit Sub If Target.Count > 1 Then Exit Sub '一応 If Intersect(Target, t) Is Nothing Then Exit Sub Cancel = True If Target.Interior.ThemeColor = xlNone Then Target.Interior.ThemeColor = xlThemeColorAccent3 ElseIf Target.Interior.ThemeColor = xlThemeColorAccent3 Then Target.Interior.ThemeColor = xlNone End If Call test1 End With End Sub
標準モジュールに、
Sub test1()
Dim r As Range Dim t As Range Dim j As Long Dim s() As String Application.ScreenUpdating = False With Worksheets("Sheet1") On Error Resume Next Set t = .Range("A4").Resize(, WorksheetFunction.CountA(.Rows(4))) On Error GoTo 0 If t Is Nothing Then Exit Sub
If .AutoFilterMode = False Then .Range("A6").CurrentRegion.AutoFilter ElseIf .FilterMode = True Then .ShowAllData End If
For Each r In t If r.Interior.ThemeColor = xlThemeColorAccent3 Then j = j + 1 ReDim Preserve s(1 To j) s(j) = r.Value End If Next
With Worksheets("Sheet1") If j = 0 Then .Range("A6").CurrentRegion.AutoFilter _ Field:=1, Criteria1:="s" Else .Range("A6").CurrentRegion.AutoFilter _ Field:=1, Criteria1:=s, _ Operator:=xlFilterValues End If End With End With Application.ScreenUpdating = True End Sub
でSheet1を一旦別のシートを表示してからアクティブして下さい。
A4〜O4のセルを右クリックで切り替えます。
(ウッシ) 2017/02/21(火) 14:35
オートフィルターで何を抽出するようにしているか、
http://www.becoolusers.com/excel/auto-filter.html
この選択画面(?)を常時表示したいということではないのですか?
トグルボタン3つだけで複雑な操作をさせるのは、
使う人が迷いませんか?
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_userform03b.html
↑の中段辺りにあるように、リストボックスにチェックボックスを表示させて
ON/OFFしてはいかがでしょう?
(まっつわん) 2017/02/21(火) 14:36
ウッシさん、ありがとうございます。 ただA4から右に向かって灰色のセルと、だぁ〜〜〜〜〜〜〜〜〜〜っとC7の内容が書き込まれて 左クリックすると確かに色は変わりますが抽出ができず全部折りたたまれてしいました。。。 けどこれはトマトとかの名前が3つくらいならいいかもですが 20個以上になるとだ〜〜〜〜〜〜〜っと横に長くなりますね(;´・ω・)
まっつわんさん、ありがとうございます。 私ははまだ若い部類ですが、会社の方々が結構お年寄りで 細かいやつを見て押したりするよりも 「 と ま と 」 「 ぱ せ り」 「 い ち ご 」 と大きいなボタンの置いて、それを押すことにより表がガチャガチャ動いて 必要な形を見れたほうが喜ばしいらしく。。。
最初はトマトはトマトだけって言ってたのに、 今度はトマトと他のも同時に見たいと言われだして、、、 ほんとこまったもんです。。。 (サラダ) 2017/02/21(火) 14:59
テーマカラーは環境によって違うのでダメですね。
後、一部
冷蔵庫番号でフィルタリング
にし忘れてました。
全体を差し替えて試して下さい。
Private Sub Worksheet_Activate()
Dim r As Range Dim oDic As Object Set oDic = CreateObject("Scripting.Dictionary") With Range("C7", Range("C" & Rows.Count).End(xlUp)) For Each r In .Cells oDic(r.Value) = True Next End With With Range("A4").Resize(, oDic.Count) .Value = oDic.keys .Interior.Color = 10092441 End With With Me If .AutoFilterMode = False Then .Range("A6").CurrentRegion.AutoFilter ElseIf .FilterMode = True Then .ShowAllData End If End With End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim t As Range With Me On Error Resume Next Set t = .Range("A4").Resize(, WorksheetFunction.CountA(.Rows(4))) On Error GoTo 0 If t Is Nothing Then Exit Sub If Target.Count > 1 Then Exit Sub '一応 If Intersect(Target, t) Is Nothing Then Exit Sub Cancel = True If Target.Interior.Color = 16777215 Then Target.Interior.Color = 10092441 ElseIf Target.Interior.Color = 10092441 Then Target.Interior.Color = 16777215 End If Call test1 End With End Sub
Sub test1()
Dim r As Range Dim t As Range Dim j As Long Dim s() As String Application.ScreenUpdating = False With Worksheets("Sheet1") On Error Resume Next Set t = .Range("A4").Resize(, WorksheetFunction.CountA(.Rows(4))) On Error GoTo 0 If t Is Nothing Then Exit Sub
If .AutoFilterMode = False Then .Range("A6").CurrentRegion.AutoFilter ElseIf .FilterMode = True Then .ShowAllData End If
For Each r In t If r.Interior.Color = 10092441 Then j = j + 1 ReDim Preserve s(1 To j) s(j) = r.Value End If Next
With Worksheets("Sheet1") If j = 0 Then .Range("A6").CurrentRegion.AutoFilter _ Field:=3, Criteria1:="s" Else .Range("A6").CurrentRegion.AutoFilter _ Field:=3, Criteria1:=s, _ Operator:=xlFilterValues End If End With End With Application.ScreenUpdating = True End Sub
(ウッシ) 2017/02/21(火) 15:10
うっしさん、返信遅くなりました>< 会議で離席してました!
質問の回答ですが 冷蔵庫番号は途切れません。
これから試してみいます!
(サラダ) 2017/02/21(火) 16:17
ウッシさん、使ってみました!
このVBAは、C7〜C165に記入されている冷蔵庫番号を A4から右に向かって、だーーーーーーーーーーーっと抜き出して その並んでるセルを左クリックすると色が変わった上に クリックされた番号とおんなじ番号がC列から隠される という仕様でOKですか? (サラダ) 2017/02/21(火) 16:35
C7〜C165の冷蔵庫番号って、「トグルボタン×15個」という話なので15種類位ですよね?
A4〜O4位までに表示されると思います。
Sheet1をアクティブにした時点ではA4〜O4位に背景色が付いていて、全データが表示されます。
右クリックしたセルは背景色無しになって、抽出対象外になります。
初期状態で逆に全データが非表示にして、A4〜O4位の背景色無しの方がいいですか?
(ウッシ) 2017/02/21(火) 16:42
ウッシさん、ありがとうございます! 使い方が解りました☆ 最高です☆
ほんとうにありがとうございました♪ (サラダ) 2017/02/21(火) 16:51
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.