hate_aaa3の技術備忘録メモ

自分用メモ(IT系)をストックしていきます。

グループ毎に見やすい様に罫線を引く【Excel VBA】

f:id:hate_aaa3:20220117135038j:plain

実行イメージ

#使い方とかがかっこ悪いので時間はがある時に見直す予定。


 

Sub group_out_line()

' 使い方 ヘッダを除く表範囲(表範囲は最下行+1行)を選択してこのマクロを動かす。

    '表の対象範囲を取得する
    t = Selection.Address
    t = Replace(t, "$", "")
    startcell = InStr(t, ":")
    s = Left(t, (startcell - 1))
    s = "$" & s
    e = Mid(t, (startcell + 1), 10000)
    
    n = ActiveCell.Offset(-1, 0).Address
    n = Replace(n, "$", "")
    n = "$" & n
    
    
    '最左列のカラムの文字列が1行上と同じでない場合は、実線となる。
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & n & "<>" & s

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.FormatConditions(1).StopIfTrue = False

    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With




    '最左列のカラムの文字列が1行上と同じの場合は、点線となる。
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND(" & s & "=" & n & "," & s & "<>" & """"")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlDot
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    Selection.FormatConditions(1).StopIfTrue = False
    
    
    '最左列のカラムの文字列が1行上と同じの場合は、点線となる。
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & s & "="""""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlLineStyleNone
    End With
    
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlLineStyleNone
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    

End Sub