Excel VBA 質問スレ Part80

[過去ﾛｸﾞ] Excel VBA 質問スレ Part80 (1002ﾚｽ)
上下前次1-新
通常表示 512ﾊﾞｲﾄ分割ﾚｽ栞
抽出解除ﾚｽ栞

このｽﾚｯﾄﾞは過去ﾛｸﾞ倉庫に格納されています｡
次ｽﾚ検索歴削→次ｽﾚ栞削→次ｽﾚ過去ﾛｸﾞﾒﾆｭｰ

350: デフォルトの名無しさん [sage] 2024/01/11(木) 21:32:22.23 ID:jLVdVVn1

>>348
そんなことするなら素直に
>セルごとに隣接判定をして罫線を描く／描かないの処理
を実装すればいいんじゃねえかと
Sub test()
Dim r As Range
Dim r2 As Range
Set r2 = Selection
For Each r In Selection
If Not isSelect(r, xlEdgeTop) Then r.Borders(xlEdgeTop).LineStyle = xlContinuous
If Not isSelect(r, xlEdgeBottom) Then r.Borders(xlEdgeBottom).LineStyle = xlContinuous
If Not isSelect(r, xlEdgeLeft) Then r.Borders(xlEdgeLeft).LineStyle = xlContinuous
If Not isSelect(r, xlEdgeRight) Then r.Borders(xlEdgeRight).LineStyle = xlContinuous
Next
End Sub
Function isSelect(testRange As Range, index As XlBordersIndex) As Boolean
On Error Resume Next
Dim r As Range
For Each r In Selection
Select Case index
Case xlEdgeTop
If r.Address = testRange.Offset(-1, 0).Address Then isSelect = True
Case xlEdgeBottom
If r.Address = testRange.Offset(1, 0).Address Then isSelect = True
Case xlEdgeLeft
If r.Address = testRange.Offset(0, -1).Address Then isSelect = True
Case xlEdgeRight
If r.Address = testRange.Offset(0, 1).Address Then isSelect = True
End Select
Next
End Function
こんな感じか。行数制限あるからやってるけど、１行If は推奨しないぞ

http://mevius.5ch.net/test/read.cgi/tech/1685489018/350

上下前次1-新書関写板覧索設栞歴

ｽﾚ情報赤ﾚｽ抽出画像ﾚｽ抽出歴の未読ｽﾚ AAｻﾑﾈｲﾙ

ぬこの手ぬこTOP 0.035s