セル内容が異なると自動で罫線を引く vba


表内のC列(3)に入力されている内容が上と下で違う場合に、二重線を引く
例えば、県別の表があり、県が違うと二重線を引くという設定。
'県別で罫線を引く
'最終列・最終行を取得
Dim kMaxRow, kMaxCol As Long
With ActiveSheet.UsedRange
kMaxRow = .Find("*", , , , xlByRows, xlPrevious).Row
kMaxCol = .Find("*", , , , xlByColumns, xlPrevious).Column
End With
Dim bVe As Variant '上のセル
Dim aVe As Variant '下のセル
Dim iVe As Variant

For iVe = 3 To kMaxRow
bVe = Cells(iVe - 1, 3)
aVe = Cells(iVe, 3)
If bVe = aVe Then
Else
Range(Cells(iVe, 1), Cells(iVe, kMaxCol)).Borders(xlEdgeTop).LineStyle = xlDouble
End If
Next
'最後の行の一番下に罫線
Range(Cells(iVe, 1), Cells(iVe, kMaxCol)).Borders(xlEdgeTop).Weight = xlMedium

スポンサーリンク

----- べんりあつめ。-----

説明
上のセルと下のセルを取得して比較。違う場合に、セルの上に二重線を引くので、最後のセルは、別でセルの下に線を引く必要有。

スポンサーリンク

スマホのみ下に表示