| |
▼桃太郎 さん：
申し上げたように、要件を具体的に説明いただければ、適切な回答も可能かと思いますが
以下は、想像をたくましくしたコード案です。
領域や、罫線要件に誤解があるかもしれませんが。
Sub test()
Dim rngCurrent As Range
Dim col As Range
Dim chk As Variant
Set rngCurrent = Range("D4:AH32")
Application.ScreenUpdating = False
'領域の罫線を処理前に削除
rngCurrent.Borders.LineStyle = xlNone
'左端、右端含めて、縦に HairLine
With rngCurrent.Offset(, -1).Resize(, rngCurrent.Columns.Count + 2).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
'領域上端、下端に細実線
With rngCurrent.Borders(xlEdgeTop)
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With rngCurrent.Borders(xlEdgeBottom)
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'土日枠
For Each col In rngCurrent.Columns
chk = Cells(40, col.Column).Value
Select Case chk
Case 1, 7
'列上端、下端に青太線
With col.Borders(xlEdgeTop)
.Weight = xlMedium
.ColorIndex = 11
End With
With col.Borders(xlEdgeBottom)
.Weight = xlMedium
.ColorIndex = 11
End With
'左あるいは右に青太線
With col.Borders(IIf(chk = 1, xlEdgeRight, xlEdgeLeft))
.Weight = xlMedium
.ColorIndex = 11
End With
End Select
Next
Set rngCurrent = Nothing
Application.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
