[過去ﾛｸﾞ] Excel VBA 質問スレ Part80 (1002ﾚｽ)
上下前次1-新
抽出解除 ﾚｽ栞

---

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

---

ﾘﾛｰﾄﾞ規制です｡10分ほどで解除するので､他のﾌﾞﾗｳｻﾞへ避難してください｡

---

348(2): 2024/01/10(水)21:34 ID:54SkLlBn(3/3)調 AAS
A1:A3外枠描いてからB3:D3の外枠左辺抜きのが楽だった
その他、右辺抜き、上辺・下辺それぞれ抜きのを、全枠と合わせて五つのマクロだけで
L字の左右反転でも上下反転でも、E字F字H字T字それぞれ上下左右反転だろうと対応できたわ

全周
　Sub all4()
Selection.BorderAround True
　End Sub
上辺抜き
　Sub nontop()
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
　End Sub
下辺抜き
　Sub nonbottom()
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
　End Sub
あと、左右は上下の真似してそれぞれxlNone するだけの、都合五つのマクロで自由自在
罫線の色とか種類を変えたいなら、それぞれに加工加えて

---

349: 338 2024/01/11(木)10:04 ID:q0ONoHEN(1)調 AAS
>>348さん
ありがとうございます。
参考にします。

---

350(1): 2024/01/11(木)21:32 ID:jLVdVVn1(1/2)調 AAS
>>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 は推奨しないぞ

---

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

---

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

---

ぬこの手 ぬこTOP 0.053s