「今さら」なんてない

「自分にもできそう」を伝播させるブログ

自作タスク管理ツール 補助機能:フィルタリング

こちらの記事で紹介したExcelタスク管理ツールの補助機能の紹介です。
はじめての方はまずはこちらの記事をどうぞ。 yoshino-ya.hatenablog.com



それでは本題です。

今回は前置きなしの手順書のみです

やること

今回はコードの貼り付け以外に少しお手間を取らせます

  1. ユーザーフォームを用意する

  2. ”設定”シートを用意する

  3. コードのコピペ(ユーザーフォーム)

  4. コードのコピペ(標準モジュール)

  5. ショートカットの割当「フィルタリング」

ユーザーフォームを用意する

Alt+F11でVBEを開く

挿入→ユーザーフォームを押す

UserForm1が挿入されます

UserForm1のオブジェクト名をUserForm1フィルタリングに変更する

図の様なプロパティが表示されてない方はF4を押して下さい

f:id:yoshino-ya:20180621044148p:plain

ユーザーフォームの部品を下図のように配置していく

ツールボックスから各部品をドラッグ&ドロップで配置していきます

各部品のサイズは8方向に伸縮出来ます

f:id:yoshino-ya:20180621044151p:plain

配置する部品とツールボックス

f:id:yoshino-ya:20180621044152p:plain

各部品のCaption、オブジェクト名を下表のように編集する
記号 Caption (オブジェクト名)
A 状態(担当) Frame1状態・担当
B カテゴリ(ファイル保存先) Frame2カテゴリ
C すべて選択 CheckBox状態すべて選択
D 当方 CheckBox1
E 先方 CheckBox2
F いつか CheckBox3
G 未到来 CheckBox4
H 完了 CheckBox5
I すべて選択 CheckBoxカテゴリすべて選択
J ListBox1カテゴリリス
K フィルタリング実行 CommandButton1フィルタリング実行
L 何も選択しないと
状態未設定(空白)の
表示になります
Label1
M 複数条件可能 Label2
N 何も選択しないと
状態未設定(空白)の
表示になります
Label3

ListBox1カテゴリリストだけはもうひと手間。プロパティの下の方のMultiSelectを1-fmMultiSeletMultiにして下さい

f:id:yoshino-ya:20180621044154p:plain

”設定”シートのG,H列に下図の様な表を用意する

G列にはカテゴリ名、H列にはそのフォルダパスを入れて下さい

f:id:yoshino-ya:20180621044157p:plain

お疲れ様でした。ここからはコピペだけです。

ユーザーフォームのコードをコピペ

UserForm1フィルタリングを右クリック→コードの表示

下記コードをコピペ

Option Explicit
Public 状態フィルタリスト As Variant, カテゴリフィルタリスト As Variant
Dim カテゴリフィルタ As String, 状態フィルタ As String, 担当 As String

Private Sub UserForm_Initialize()
    Dim i As Integer
    
    '選択状態の呼び出し
        状態フィルタリスト = GetSetting("MyMacro", "Form", "状態フィルタ")
        カテゴリフィルタリスト = GetSetting("MyMacro", "Form", "カテゴリフィルタ")
        
    '状態リストのレジストリ読み込み→選択状態にする
        If InStr(状態フィルタリスト, "当方") > 0 Then: CheckBox1 = True
        If InStr(状態フィルタリスト, "先方") > 0 Then: CheckBox2 = True
        If InStr(状態フィルタリスト, "いつか") > 0 Then: CheckBox3 = True
        If InStr(状態フィルタリスト, "未到来") > 0 Then: CheckBox4 = True
        If InStr(状態フィルタリスト, "完了") > 0 Then: CheckBox5 = True

End Sub
        
Private Sub CheckBox状態すべて選択_Click()
    Dim i As Integer
    If CheckBox状態すべて選択.Value = True Then
        CheckBox1 = True
        CheckBox2 = True
        CheckBox3 = True
        CheckBox4 = True
        CheckBox5 = True
    Else
        CheckBox1 = False
        CheckBox2 = False
        CheckBox3 = False
        CheckBox4 = False
        CheckBox5 = False
    End If
End Sub

Private Sub CommandButton1フィルタリング実行_Click()
    '状態------------------------------------------------
        Dim 担当 As String, C
        For Each C In Controls
            If TypeName(C) = "CheckBox" Then
                If C.Value Then: 状態フィルタ = 状態フィルタ & C.Caption & ","
            End If
        Next C
        If 状態フィルタ <> "" Then
            状態フィルタ = Left(状態フィルタ, Len(状態フィルタ) - 1)
        Else
            状態フィルタ = " "
        End If

        状態フィルタリスト = Split(状態フィルタ, ",")
              
    'カテゴリ--------------------------------------------
        Dim i As Long
            
            For i = 0 To ListBox1カテゴリリスト.ListCount - 1
                If ListBox1カテゴリリスト.Selected(i) = True Then
                    カテゴリフィルタ = カテゴリフィルタ & ListBox1カテゴリリスト.List(i) & ","
                End If
            Next i
            If カテゴリフィルタ <> "" Then
                カテゴリフィルタ = Left(カテゴリフィルタ, Len(カテゴリフィルタ) - 1)
            Else
                カテゴリフィルタ = " "
            End If
            
            カテゴリフィルタリスト = Split(カテゴリフィルタ, ",")
        
    '選択状態の保存
        SaveSetting "MyMacro", "Form", "状態フィルタ", 状態フィルタ
        SaveSetting "MyMacro", "Form", "カテゴリフィルタ", カテゴリフィルタ
        
    '実行--------------------------------------------
        Call フィルタリング実行
        Unload Me
    
End Sub

Sub フィルタリング実行()
    Dim 現在のセル行, 現在のセル列
    Dim 完了フラグ, Rlast
    
    '最終列
        Const Clast = "K"

    '画面更新非表示
        Application.ScreenUpdating = False

    現在のセル行 = ActiveCell.Row
    現在のセル列 = ActiveCell.Column

    '最下行探し
        Rlast = Cells(Rows.Count, 3).End(xlUp).Row
        
    'メイン
        ActiveSheet.Range(Cells(7, "D"), Cells(Rlast, Clast)).AutoFilter Field:=1, _
        Criteria1:=状態フィルタリスト, _
            Operator:=xlFilterValues
        ActiveSheet.Range(Cells(7, "D"), Cells(Rlast, Clast)).AutoFilter Field:=8, _
        Criteria1:=カテゴリフィルタリスト, _
            Operator:=xlFilterValues
    
    '後処理
        Cells(現在のセル行, 現在のセル列).Select
        ActiveSheet.Outline.ShowLevels RowLevels:=1

    '画面更新有効化
        Application.ScreenUpdating = True
End Sub


Private Sub CheckBoxカテゴリすべて選択_Click()
    Dim i As Integer
    If CheckBoxカテゴリすべて選択.Value = True Then
        For i = 0 To ListBox1カテゴリリスト.ListCount - 1
            ListBox1カテゴリリスト.Selected(i) = True
        Next i
    Else
        For i = 0 To ListBox1カテゴリリスト.ListCount - 1
            ListBox1カテゴリリスト.Selected(i) = False
        Next i
    End If
End Sub

標準モジュールを挿入し、下記コードをコピペする

Option Explicit
    Public Rs As Long, Rm As Long, Re As Long '開始・終了行
    Public Rlast As Long, Clast
    Public r As Long, C As Long
    Dim 完了フラグ
    Public カテゴリフィルタ_old
    
Sub 完了の非表示と再表示()
    
    Dim 現在のセル行, 現在のセル列, フィルタ開始行, フィルタ終了行
    
    '最終列
        Const Clast = "P"

    '画面更新非表示
        Application.ScreenUpdating = False
        
    '準備
        現在のセル行 = ActiveCell.Row
        現在のセル列 = ActiveCell.Column
        Rlast = GetSetting("MyMacro", "マスタ", "最終行")
            
        'フィルタ範囲の設定
           フィルタ開始行 = GetSetting("MyMacro", "マスタ", "表示開始行")
           フィルタ終了行 = GetSetting("MyMacro", "マスタ", "表示終了行")
    
        'Hiddenフラグ付与
            Dim r As Variant
            For Each r In Range("A:A")
                If Rows(r.Row).Hidden = True Then
                    Cells(r.Row, "P").Value = True
                Else
                    Cells(r.Row, "P").Value = ""
                End If
                
                If r.Row >= Rlast Then: Exit For
            Next r
            
    '場合分け:完了フラグ
        If 完了フラグ = True Then
            ActiveSheet.Range(Cells(フィルタ開始行, "D"), Cells(フィルタ終了行, Clast)).AutoFilter
            完了フラグ = False
        Else
        
        'すでにあるフィルタを除去しておく
                ActiveSheet.Range(Cells(フィルタ開始行, "D"), Cells(フィルタ終了行, Clast)).AutoFilter
        
        'メイン
            ActiveSheet.Range(Cells(フィルタ開始行, "D"), Cells(フィルタ終了行, Clast)).AutoFilter Field:=6, _
            Criteria1:="="
        
            完了フラグ = True
        
        End If
            
    'Hiddenフラグによる非表示(ズーム時など)
        For Each r In Range("P:P")
            If Cells(r.Row, "P").Value = True Then: Rows(r.Row).Hidden = True
            If r.Row >= Rlast Then: Exit For
        Next r
        
    '後処理
        Cells(現在のセル行, 現在のセル列).Select

    '画面更新有効化
        Application.ScreenUpdating = True
End Sub

Sub フィルタリング()
    '保存先テーブルの最終行を取得しておく
        Dim 保存先最終行 As Long
        Dim i As Long
        保存先最終行 = Sheets("設定").Cells(Rows.Count, "G").End(xlUp).Row
        
    'カテゴリリストをシート(設定)から取得する
        Load UserForm1フィルタリング
        UserForm1フィルタリング.ListBox1カテゴリリスト.ColumnCount = 2
        UserForm1フィルタリング.ListBox1カテゴリリスト.RowSource = "設定!G4:G" & 保存先最終行
        
    '選択状態の呼び出し
        カテゴリフィルタ_old = GetSetting("MyMacro", "Form", "カテゴリフィルタ")
        For i = 0 To UserForm1フィルタリング.ListBox1カテゴリリスト.ListCount - 1
            If InStr(カテゴリフィルタ_old, UserForm1フィルタリング.ListBox1カテゴリリスト.List(i)) > 0 Then
                UserForm1フィルタリング.ListBox1カテゴリリスト.Selected(i) = True
            End If
        Next i

    UserForm1フィルタリング.Show
    
End Sub

ショートカットの割当「フィルタリング」

”設定”シートのショートカット割当をします。僕はいったんF4にしています

ショートカット割当方法はこちらをどうぞ

yoshino-ya.hatenablog.com

お疲れ様でした。今回は手順をまとめるのに時間を要したのでブログとしての本文は割愛してしまいました。みなさんすごいな、、、