|
▼のうさぎ さん:
おはようございます
一例です
Sub Sample()
Dim i As Long
Dim z As Long
Dim cnt As Long
Dim myStyle As Long
Dim myWeight As Long
'処理前にA列の罫線があれば削除
Columns("A").Borders.LineStyle = xlNone
'A列データ最終行の取得
z = Range("A" & Rows.Count).End(xlUp).Row
cnt = 1
'2行目から最終行の次の行までループ処理
For i = 2 To z + 1
myStyle = 0
'前の行と値がかわったか?
If Range("A" & i).Value <> Range("A" & i - 1).Value Then
cnt = 1
myStyle = xlDouble '二重線
myWeight = xlThick
Else
cnt = cnt + 1
'5行おきに線
If (cnt - 1) Mod 5 = 0 Then
myStyle = xlContinuous
myWeight = xlThin
End If
End If
If myStyle Then 'スタイルがセットされていたら
With Range("A" & i).Borders(xlEdgeTop)
.LineStyle = myStyle
.Weight = myWeight
.ColorIndex = xlAutomatic
End With
End If
Next
End Sub
|
|