IF文(Excel VBA)
k.w
SEへの道
全体の フィルタ を実行したい場合、単一列ごと(一つの列設定を複数回)であれば、Excelの標準機能のフィルタを使えば、絞り込みが可能です。でも、複数列にまたがる場合は面倒ですよね?そんな時、 複数列 のフィルタリングは VBA でちょちょいのちょいです。
特定範囲に入力されたセルすべてのフィルタリング
ポイントはセルの結合です。
すべてのセルに対して標準的にフィルタができる機能はありません。
そこで同一行のセルを結合してしまえば・・・
なんとなくイメージがつきましたか?
複数のセルを対象としたフィルタができないなら、一つのセルにしてしまえば一列のフィルタと同じ動作をすることができます。
Excelに一列追加して、全列を結合してそのセルを・・・
スマートじゃないですよね?
では、さっそくやってみましょう!
とその前に、やるからには使えるものとしたいので、部分一致フィルタにも活用できるように入力ダイアログ(ユーザフォーム)も事前に準備しましょう。
さくっとユーザフォームで条件入力画面を作ってみましょう。
①Editorを開く
②挿入/ユーザフォーム選択
③左下図をイメージを参考に
・入力画面:textbox1
・部分一致選択:checkbox1
・実行ボタン:commandbutton1
・キャンセル:commandbutton2
※本ソースは上述ユーザフォームのモジュールに記載することを間違えないように!
Private Sub commandbutton1_Click()
'引数の宣言
Dim wrkdata As String
Dim y As Long '----縦方向セル座標
Dim x As Long '----横方向セル座標
Dim rw As Long '----行数カウント用
Dim clm As Long '----列数カウント用
'フィルタ条件が入力されていないと中断
If Textbox1.value = "" Then
MsgBox "フィルタ条件が入力されていません"
Exit Sub
End If
'事前準備(非表示解除および範囲取得)
Rows.Hidden = False
rw = Cells(Rows.Count , 1).End(xlUp).Row
clm = Cells(1 , Columns.Count).End(xlToLeft).Column
'作業引数wrkdataにセルの値をセット(一列毎)
For y = 2 to rw '----2列目から最終行まで処理
wrkdata = "" '----作業引数リセット
For x = 2 to clm
wrkdata = wrkdata & ""."" & Cells(y , x).Value '----(1)
'----列再右まで繰り返し結合
'----"."は同一列のセル結合時の結合箇所の誤認識防止
Next x
'抽出条件を含む/含まない判断。(チェックボックス判断)
If CheckBox1.Value = True Then
''①フィルタ条件を含む抽出:一致(部分一致も)しなければ(含まなければ"0")非表示
If Instr(wrkdata , TextBox1.Value) = 0 Then '----(2)
Rows(y).Hidden = True
End If
Else
''②フィルタ条件を含まない抽出:一致するなら(含まれるなら"0"以上)非表示
If Instr(wrkdata , TextBox1.Value) > 0 Then '----(3)
Rows(y).Hidden = True
End If
End If
Next y
End Sub
今回の処理のポイントは以下です。
Private Sub commandbutton2_Click()
'非表示解除
Rows.Hidden = False
End Sub
Private Sub UserForm_Initialize()
'初期設定
CheckBox1.Value = True
End Sub
いかがでしょうか?
ちょっとした考え方の切り口を変えることで出来ないことが出来る。
スカッとする瞬間です。
ただ、毎回手動で実行するのは面倒なので、右クリックで条件入力ウィンドウを表示させる補足ソースも参考にしてみてください。