「今さら」なんてない

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

納期フィルタ(Excel VBA タスク管理ツール補助機能)

長らく更新できていませんでした、、、

僕自身が自分で作ったツール以外に手を出しすぎていたためです、、、

でも結局これに帰ってきそうな気がしているので
途中までやりかけていた完了非表示モノを進めました。

今回は単純コピペだけでかなり使い勝手がよくなる良くできた機能だと思います。
(ただのフィルタリングですが難しく考えすぎていました、、、)

できること

ショートカットを押す度、以下4パターンを切り替えます。

  • 今日やることだけ表示
  • 一週間分だけ表示
  • 未完了案件だけを表示
  • 全案件を折りたたんだ状態で表示

※今日と1週間については色で判断している為、
色が合わないと機能しません、、、

色パレットを一箇所にまとめることもしていきたいですね、、、


やること

標準モジュールコピペするコード

標準モジュールを挿入し、下記のコードをコピペして下さい。
僕は下記リンクのフィルタリング(状態・カテゴリ)のモジュールに加筆する形をとっています。

yoshino-ya.hatenablog.com

’’’

Sub 納期フィルタ() '2018/5/30 完了列のみに変更(状態列はユーザーフォームからに変更)

Dim 現在のセル行, 現在のセル列, フィルタ開始行, フィルタ終了行

'最終列
    Const Clast = "P"

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

'準備
    現在のセル行 = ActiveCell.Row
    現在のセル列 = ActiveCell.Column
    Rlast = GetSetting("MyMacro", "マスタ", "最終行")

    'フィルタ範囲の設定
       フィルタ開始行 = GetSetting("MyMacro", "マスタ", "表示開始行")
       フィルタ終了行 = GetSetting("MyMacro", "マスタ", "表示終了行")

    'すでにあるフィルタを除去しておく
        ActiveSheet.Range(Cells(フィルタ開始行, "D"), Cells(フィルタ終了行, Clast)).AutoFilter

    '押す度にフィルタ切り替え
        Select Case フィルタフラグ

            Case Is = 1 'オレンジ(1週間以内)
                ActiveSheet.Range(Cells(フィルタ開始行, "D"), Cells(フィルタ終了行, Clast)).AutoFilter Field:=5, _
                Criteria1:=RGB(255, 192, 0), Operator:=xlFilterCellColor
                フィルタフラグ = 2
            Case Is = 2 '完了非表示
                ActiveSheet.Range(Cells(フィルタ開始行, "D"), Cells(フィルタ終了行, Clast)).AutoFilter Field:=6, _
                Criteria1:="="
                フィルタフラグ = 3
            Case Is = 3
                ActiveSheet.Outline.ShowLevels RowLevels:=1
                フィルタフラグ = 4
            Case Else '赤(当日)
                ActiveSheet.Range(Cells(フィルタ開始行, "D"), Cells(フィルタ終了行, Clast)).AutoFilter Field:=5, _
                Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
                フィルタフラグ = 1
        End Select


'ズーム処理
    Rows(6 & ":" & フィルタ開始行 - 1).Hidden = True
    Rows(フィルタ終了行 + 1 & ":" & Rlast).Hidden = True
'タイトル行は常に表示する
    Rows(1 & ":" & 5).Hidden = False
    Rows(7).Hidden = False

'後処理
    Cells(現在のセル行, 現在のセル列).Select

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

End Sub ’’’

ショートカットの割当「納期フィルタ」

”設定”シートのショートカット割当をします。僕はいったんCtrl+Oにしています
ショートカット割当方法はこちらをどうぞ

yoshino-ya.hatenablog.com

以上です 今回、画像等用意できませんでした、、、