色彩検定1級を取得する魅力を紹介♪

※先日似たような質問をしたのですが、少し条件が変わったらうまくまとめられなくて、
 改めて質問させて頂きます。

マクロの記録で罫線を引く様子を記録したら以下の様になりました。
やりたかったことは、
・表全体の罫線を、実線で囲み、縦も実線、横は細い線
・表の1行目の下部だけ、実線
記録の結果はこんなに長くなってしましましたが、
短くまとめられますでしょうか?
行数は可変するので一番下までという事で、

「n = Application.Max(Cells(Rows.Count, 2).End(xlUp).Row, 2) - 2」と、
「With Range("A3:D3").Resize(n).Borders」なのかなと思ってますが、
まだ応用できません・・・

---------- マクロの記録 ----------
Sub Macro1()
Range("A3:D13").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
Range("A3:D3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A3").Select
End Sub

gooドクター

A 回答 (3件)

こんにちは


>行数は可変するので一番下までという事で、
この一番下とは何を基準にすれば良いのでしょうか?

示されている記録マクロを纏めると下記のようでも良いと思います。
デフォルトプロパティは省略していますが、違っていたら書き加えてください。
最終行はA列で値が入っている一番下のセルが行番号になっています。
A列4行目以下に値がない場合は、5行目までを対象にします。

Sub Macro1()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
If lastRow < 4 Then lastRow = 5
With Range("A3:D" & lastRow)
.Borders.LineStyle = True
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
Range("A3:D3").Borders(xlEdgeBottom).Weight = xlThin
Range("A3").Select
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます!

>この一番下とは何を基準にすれば良いのでしょうか?

取り急ぎA列基準で対応してくれたみたいですね、ありがとうございます。
それで問題ないです。
最終行(lastRow)は別の箇所で使用していたのでそこを再利用しました。

今試してみました。
期待通りの結果でした。
何故すぐにこんな簡潔にまとめられるのでしょう。
まだそれを作れる脳になってません。。。
一行一行読み解いているところです。

・A3からD列の最終行の範囲に対して罫線を引く
・A3からD3の範囲に対して罫線を引く
これで完成させているように見受けられました。
上下左右自由に引けるようになりたいです。

お礼日時:2021/05/18 18:51

こんばんは



既に回答は出ていますけれど・・・

No1様がご回答の方式をそのままコードにしただけのものです。

Sub Sample_Q12366124()
Dim n
n = Application.Max(Cells(Row.Count, 1).End(xlUp).Row, 3)

With Range("A3:D3").Resize(n - 2)
 .Borders.ColorIndex = xlAutomatic
 .Borders.LineStyle = True
 .Borders.Weight = xlThin

 .Borders(xlInsideHorizontal).Weight = xlHairline
 .Rows(1).Borders(xlEdgeBottom).Weight = xlThin
End With
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます。
これもすっきりしちゃいましたね。

No.2さんのと記述は違いますが、結果は同じって事ですね。

お礼日時:2021/05/19 09:50

簡単に罫線を引く


http://officetanaka.net/excel/vba/tips/tips51.htm

全て同じに描いてから別の条件があるならそこだけを後から再描画するとか?
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング