選択した経路で罫線を作成 - Infomentのブログ～Excel VBA奮闘記～

昨日はマクロを使用しない方法で、こちらに挑戦しました。

infoment.hatenablog.com

でも折角なので、マクロを使用したらどうなるかも考えてみました。
※お題には「マクロ使用不可」とあるので、この方法は時間計測対象外です。

今回の法則は突き詰めてみると、以下のように単純化できます。
［選択セルについて］

上下左右全てに罫線が引かれている場合、何もしない。
1. の条件に合致しない場合、罫線が無い辺に中線を引く。
1. の条件に合致しない場合、既存の中線は細線に変更する。
上記に関係なく、内部の線は縦・横共に細線を引く。
上記に関係なく、斜め線は今回の処理対象から除外する。

今回改めて確認したところ、各線は以下の番号で設定できることが分かりました。

左辺　Borders(7)
上辺　Borders(8)
下辺　Borders(9)
左辺　Borders(10)
中縦　Borders(11)
中横　Borders(12)

これを踏まえて作成したのが↓こちらです。
［標準モジュール］

Option Explicit

Sub ChangeLineStyle(target_range As Range)
    With target_range
        Dim i As Long
        Dim j As Long
        ' 上下左右全てに罫線がある場合、処理を中断する。
        ' ※xlNone=-4142であるため、一本でも線が無ければ合計値は負になる。
            j = 0
            For i = 7 To 10
                j = j + .Borders(i).LineStyle
            Next
            If j > 0 Then Exit Sub

            For i = 7 To 10
            ' 上下左右の罫線について、処理前の状態を元に罫線を引く。
                If .Borders(i).LineStyle = xlNone Then
                    .Borders(i).Weight = xlThin
                Else
                    .Borders(i).Weight = xlHairline
                End If
            ' 内部の線は、無条件で細線を引く。
                .Borders(11).Weight = xlHairline
                .Borders(12).Weight = xlHairline
            Next
    End With
End Sub

罫線は、セルを選択すれば引かれるようにしました。また、右クリックを消しゴム代わりにしています。
［シートモジュール］

Option Explicit

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    '右クリックで消しゴムの代わり。
    Target.Borders.LineStyle = xlNone
    Cancel = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' シート全体を選んでしまった場合の対策。
    On Error Resume Next
    If Target.Count > 100 Then Exit Sub
    
    ' 罫線を引く。
    Dim r As Range
        For Each r In Target
            Call ChangeLineStyle(r)
        Next
End Sub