「今さら」なんてない

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

週の見積時間欄から日付指定フィルタをかける(Excel VBA 自作タスク管理ツール機能拡張)

タスク管理ツールにおける使い勝手の良さって
結局は

俯瞰力と抽出力

に尽きるんじゃないか
と思い始め、今さら基本機能を追加しました。
(これまでここの処理を無駄に難しく考えすぎていました、、、)

週ごとや1日ごとだけに
視野を絞り込むことで
使い勝手が格段に向上しました。

これまで色々と盛り込んだ機能も
この基本機能が加わることでようやく活かせるようになってきたのかなと思います。

では例によって機能説明とインストール方法の説明です。

できること

タイトル行あたりの週の見積時間欄から
指定日付だけを抽出します。

f:id:yoshino-ya:20180922150717p:plain
日付のセルをダブルクリックすると

f:id:yoshino-ya:20180922150722p:plain
その日だけが抽出されます。

ね、簡単でしょ?


インストール方法

事前にフィルタリングもインストールしておいて下さい。

WorkSheetモジュールにコードをコピペする

以前挙げた折畳・展開プロシージャの呼び出し部分を一部変更する形になります。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) の部分を上書きして下さい。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    If Target.Row >= 8 Then
        Cancel = True
        Call 折畳_展開
    End If
    
    With Target
        If .Address = "$B$5" Or _
            .Address = "$C$1" Or _
            .Address = "$C$2" Or _
            .Address = "$C$3" Or _
            .Address = "$C$4" Or _
            .Address = "$C$5" Then
                Cancel = True
                Call 週の予定からその日の予定を開く
        End If
    End With
End Sub

標準モジュール(フィルタ)にコードをコピペする

Sub 週の予定からその日の予定を開く()
    Dim 現在のセル行, 現在のセル列, フィルタ開始行, フィルタ終了行
    Dim SchDate 'As Object
        
    '最終列
        Const Clast = "P"

    '画面更新非表示
        Application.ScreenUpdating = False
        
    '準備
        現在のセル行 = ActiveCell.Row
        現在のセル列 = ActiveCell.Column
        Rlast = GetSetting("MyMacro", "マスタ", "最終行")
        
    '開く日付
        SchDate = Split(ActiveCell, " ")
        
    'フィルタ範囲の設定
       フィルタ開始行 = 7
       フィルタ終了行 = Rlast

    ActiveSheet.Range("$D$" & フィルタ開始行 & ":$K$" & フィルタ終了行).AutoFilter Field:=5, Operator:= _
        xlFilterValues, _
        Criteria2:=Array(2, SchDate(0))

End Sub

以上です。

約2ヶ月もアップしていないと
逆に肩の力が抜けて、要点しかアップしなくなって
それはそれで良い効果が得られたのかもしれません。

この自作ツールの使い方というか
応用例みたいなのも記事にすると良いのかもしれません。