データがあるところまで罫線を引くマクロの方法

質問

エクセルのマクロの記録機能でピポットＴＢＬをコピーして貼り付けを行うマクロを作ったのですが、
最終行の下の線だけ罫線がひかれていません。

最終行を計算し下の線だけ引くマクロのやり方はどのようにしたら
よろしいでしょうか？

回答宜しくお願いいたします

回答No.2

Wendy02

こんにちは

>エクセルのマクロの記録機能でピポットＴＢＬをコピーして貼り付けを行うマクロ

記録マクロで範囲を取れるのかは知りませんが、コピーは、Test1のようにすればよいのでは？

記録マクロの最後の罫線が抜けるという現象は確認できません。もし、そうなら、Test1 では、もしかしたら、以下は、罫線は引かれないのかもしれません。

もし、そうなら、Test2 のマクロのように、TableRange1 の最後の部分を引き直せばよいと思います。
ただ、一番下の行だけを xlEdgeBottomで本当に可能なのかよく分かりません。もしかしたら、最後の行と次の行を選択して、xlInsideHorizontalで、線を引くのかもしれません。それは、こちらでは再現できませんので、やってみないとわかりません。

'-------------------------------------------
Sub Test1()
　　Dim PV As PivotTable
　　Set PV = ActiveSheet.PivotTables(1)
　　If Not PV Is Nothing Then
　　　　PV.TableRange1.Copy Worksheets("Sheet2").Range("A1")　'コピー先
　　End If
　　Set PV = Nothing
End Sub

'-------------------------------------------
Sub Test2()
　　Dim PV As PivotTable
　　Dim r As Range
　　Dim n As Variant
　　Dim i As Long
　　Set PV = ActiveSheet.PivotTables(1)
　　If Not PV Is Nothing Then
　　　　With PV.TableRange1
　　　　　　.Copy Worksheets("Sheet2").Range("A1")　'コピー先
　　　　End With
　　　　Set r = Worksheets("Sheet2").Range("A1").CurrentRegion
　　　　i = r.Rows.Count 'PivotTableの行数
　　　　With r.Rows(i).Borders(xlEdgeBottom) '最後の行数
　　　　　　.LineStyle = xlContinuous
　　　　　　.Weight = xlThin
　　　　　　.Color = vbBlack
　　　　End With
　　End If
　　Set PV = Nothing
　　Set r = Nothing
End Sub

回答No.1

NOBNNN

具体的な表のイメージがわからないですが　ただ単に罫線を最終行に加えるだけならそんなに難しくはありません。

サンプルとして　添付した画像の表にて説明します。

下の線だけ引くマクロをあらかじめ新規にマクロを作成するために以下の操作を行ってください。
１．まず、結果シート、
つまり現在の「マクロの記録機能でピポットＴＢＬをコピーして貼り付けを行うマクロ」
を実行したものを用意してください。

2.全部のデータは必要ありませんので10行くらいの状態にしてください。

3.罫線を引くマクロを作成します。
　3.1 メニューバーのツール→マクロ→新しいマクロの記録
　3.2 最下行（10行目）のセルすべてを選択（ドラッグ）状態にします。
　3.3 メニューバーの書式　→　セル　→　罫線　を開き、下線の罫線を引きます
　3.4 マクロの記録を終了します。
　3.5 メニューバーのツール→マクロ→マクロの編集を開きます。 (VBのエディッタが開きます）
　 以下はサンプル表のマクロです。

　___________________________________________________________________________________________
　Sub Macro2()
'
' Macro2 Macro
' マクロ記録日 : 2009/11/29 ユーザー名 : NOBU
'

'
Range("C8:G8").Select '　→　ここをなおします。

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
____________________________________________________________________________________

　　　3.5.1 最初のコード　たとえば　 Range("C8:G8").Select　の部分を工夫してあげれば
　　　　　　ご希望の状態の結果がえられます。
　　　　　　つまり現在の「マクロの記録機能でピポットＴＢＬをコピーして貼り付けを行うマクロ」
　　　　　　にて最終行だったら　この記録した上記のマクロを実行すればできるはずです。
　　　　　　 Range("C8:G8").Select　の部分を　最下行　に位置づけるコードにしてあげてください。