幾つかのプロシージャに分割してみる

昨日は、書類の提出状況に対応する色でセルを塗りつぶし、見える化したいという要望に応えてみた。実際はこれをテーマとし、職場で行った勉強会の内容をなぞってみた。
infoment.hatenablog.com
今日はその発展形として、まずは一つだったプロシージャを幾つかに分割することに挑戦する。

前回のマクロは、一連の流れが一つのサブプロシージャに収められていた。

1. セル内で二回改行された文字列の、二行目から管理番号を取得する。
2. 書類提出状況管理テーブルを検索し、書類の提出状況を取得する。
3. 書類の提出状況から、塗りつぶす色を決定する。
4. セルを塗りつぶす。

そこでまず、書類の提出状況に対応する色を返すユーザー定義関数を作成する。

Function GetColor(doc_1 As String, doc_2 As String) As Long
    If doc_1 = "〇" And doc_2 = vbNullString Then
        GetColor = vbBlue
    ElseIf doc_1 = vbNullString And doc_2 = "〇" Then
        GetColor = vbRed
    ElseIf doc_1 = "〇" And doc_2 = "〇" Then
        GetColor = vbYellow
    Else
        GetColor = vbWhite
    End If
End Function

書類１と書類２の提出状況を引数として、塗りつぶす色を戻り値としている。

次に、書類提出状況管理テーブルの内容から、辞書（連想配列）を作成する。

Function GetColorDict() As Dictionary
    ' 書類提出状況管理テーブル。
    Dim Tb As ListObject
    Set Tb = Sheets("書類提出状況管理").ListObjects(1)
    
    Dim Dict As Dictionary
    Set Dict = New Dictionary
    
    Dim doc(1 To 2) As String
    
    Dim r As Range
        For Each r In Tb.ListColumns("管理番号").DataBodyRange
            doc(1) = r.Offset(, 1)
            doc(2) = r.Offset(, 2)
            Dict(r.Value) = GetColor(doc(1), doc(2))
        Next
        
    Set GetColorDict = Dict
End Function

最後に、セルを引数として、管理番号を戻り値とする関数を作成する。

Function GetControlNumber(target As Range) As String
    If target.Value = vbNullString Then
        GetControlNumber = vbNullString
    Else
        GetControlNumber = Left(Split(target.Value, vbLf)(1), 7)
    End If
End Function

以上を踏まえて、案件管理の表を着色してみる。

Sub test()
    Dim r As Range
    Dim Dict As Dictionary
    Set Dict = GetColorDict
    Dim ControlNumber As String
        For Each r In Selection
            ControlNumber = GetControlNumber(r)
            If Dict.Exists(ControlNumber) Then
                r.Interior.Color = Dict(ControlNumber)
            End If
        Next
End Sub

結果として、元のコードより大分長くなってしまった。
ただ、それぞれの役割は明確になったと思う。

参考まで。