[過去ﾛｸﾞ] Excel VBA 質問スレ Part80 (1002ﾚｽ)

Excel VBA 質問スレ Part80 http://mevius.5ch.net/test/read.cgi/tech/1685489018/

上下前次1-新
通常表示 512ﾊﾞｲﾄ分割 ﾚｽ栞
抽出解除 ﾚｽ栞

---

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

---

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

---

348: デフォルトの名無しさん [sage] 2024/01/10(水) 21:34:25.26 ID:54SkLlBn 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 するだけの、都合五つのマクロで自由自在 罫線の色とか種類を変えたいなら、それぞれに加工加えて http://mevius.5ch.net/test/read.cgi/tech/1685489018/348

349: 338 [sage] 2024/01/11(木) 10:04:37.01 ID:q0ONoHEN >>348さん ありがとうございます。 参考にします。 http://mevius.5ch.net/test/read.cgi/tech/1685489018/349

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

---

ﾒﾓ帳

(0/65535文字)

---

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

---

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

---

Google検索

Wikipedia

---

ぬこの手 ぬこTOP 0.039s