表の罫線を引く

Option Explicit

Sub WriteLines()
Dim baseAreaRow As Long '区切りの罫線引くために、区切り調べる範囲の行
Dim baseAreaCol As Long '区切りの罫線引くために、区切り調べる範囲の列
Dim startRow As Long
Dim startCol As Long '選択範囲の開始列
Dim endCol As Long '選択範囲の終了列
Dim bottomBorder As Border
Dim memoLineStartRow As Long 'これで普通線の行覚えといて、次に普通線出てきたら、その間を破線で埋める？
Dim i As Long

    baseAreaRow = 5
    baseAreaCol = 2
    
    startRow = 6
    
    startCol = Selection.Cells(1).Column
    endCol = Selection.Cells(Selection.Count).Column
    
    memoLineStartRow = 0

With ActiveSheet
    
    For i = 1 To 20 '左端エリア上から見ていくか
        Set bottomBorder = .Cells(i, baseAreaCol).Borders(xlEdgeBottom)
        'xlDashもxlContinuousに含まれる。GUIで引いた破線これxlContinuousのxlHairlineだ。表のんどっちだっけ
        If (bottomBorder.Weight = xlThin Or bottomBorder.Weight = xlMedium) _
        And bottomBorder.LineStyle = xlContinuous Then  '普通の線か太線(winでもxlMedium？)で、かつ実線なら、選択範囲にも同じ実線引いてあと間を破線？で埋める
            .Range(.Cells(i, startCol), .Cells(i, endCol)).Borders(xlEdgeBottom).LineStyle = bottomBorder.LineStyle '線引く
            .Range(.Cells(i, startCol), .Cells(i, endCol)).Borders(xlEdgeBottom).Weight = bottomBorder.Weight 'ひとまず実線引く
            '前回の実線から今回の実線までの間に破線引く
            If memoLineStartRow <> 0 Then
                .Range(.Cells(memoLineStartRow, startCol), .Cells(i, endCol)).Borders(xlInsideHorizontal).Weight = xlHairline '.LineStyle = xlDash         ''''''xlDashだっけ。xlDot？ それかborders.weightがxlhairline？
            End If
            memoLineStartRow = i + 1
        End If
    Next i
    
    '縦線は、横線引き終わって最後のmemoLineStartRowで行範囲が分かってからにする？
    .Range(.Cells(startRow, startCol), .Cells(memoLineStartRow - 1, endCol)).Borders(xlInsideVertical).LineStyle = xlContinuous
    '周囲を太線(winもxlMediumでいい？)で囲う
    .Range(.Cells(startRow, startCol), .Cells(memoLineStartRow - 1, endCol)).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
    
End With

End Sub