ブック内に会計仕分けの元帳シート（50シートほど）

質問

ブック内に会計仕分けの元帳シート（50シートほど）
この各シート月締めのための二重罫線を引きたいです

日付列（A）をロールアップにて最終書き込みセルを探し、
そのセルに二重下線、列A～Gまでをマクロで全元帳シートに。

？
ループ処理のコードはだいたいわかります。
マクロ記録してみましたが、
A７５（下記コードの場合）は、元帳シートにより異なるので、
任意（変数？）にしたい場合はどうすれば？
？
下記記録は、列A～Eのコードが書かれているのでしょうか？
AとかBとか、Eが見当たらない！？
？

Sub Macro1()
Selection.End(xlUp).Select
Range("A75:A75").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 = xlDouble
.Weight = xlThick
.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
Range("A1").Select
End Sub

どなたか、ご指導願います

回答No.1

hallo-2007 · ベストアンサー

>下記記録は、列A～Eのコードが書かれているのでしょうか？
>AとかBとか、Eが見当たらない！？
マクロを実行してみるとわかると思いますが
二重下線が引かれるのはA75セルのみでしょう。
Range("A75:A75").Select
と指定しているからです。
それとマクロの記録ですので不要な部分が多数記録されています。
上記のマクロを
Sub Macro1()
Selection.End(xlUp).Select
Range("A75:A75").Select
Selection.Borders(xlEdgeBottom).LineStyle = xlDouble
End Sub
だけでもA75セルに二重下線が引かれるはずです。
では　A75からG75セルに二重下線を引くには
Sub Macro1()
Selection.End(xlUp).Select
Range("A75:G75").Select
Selection.Borders(xlEdgeBottom).LineStyle = xlDouble
End Sub
では　75ではなくて最終行を探してみます。
Sub Macro1()
GYOU=Range("A65536").End(xlUp).Row
Range("A" & GYOU & ":G" & GYOU).Select
Selection.Borders(xlEdgeBottom).LineStyle = xlDouble
End Sub
もう少し省略するとしたら
Sub Macro1()
GYOU=Range("A65536").End(xlUp).Row
Range("A" & GYOU & ":G" & GYOU).Borders(xlEdgeBottom).LineStyle = xlDouble
End Sub

後は
上記の２行のコードを　それぞれのシートに対してシートの数分だけループ処理するわけです。

お礼

無事解決です！ありがとうございました。

回答No.4

hallo-2007

tom04さんが全ての回答をしてくれていますね。
VBAの勉強という意味で
Sub ボタン3_Click()
For i = 1 To ThisWorkbook.Sheets.Count
Sheets(i).Activate
MsgBox "シートを移動しました"
Next
End Sub
を実行してみてください。
シートが上から順にアクティブになっていきます。
このMsgBox "シートを移動しました"の部分に先に説明した
2行のコードと置き換えて実行してみてください。
コードの丸写しではダメですよ。

回答No.3

tom04

No.2です！
たびたびごめんなさい。

通常はSheet名をすべてのSheetにつけていらっしゃると思いますので、
前回のコードではたぶんマクロは動かないと思います。

コードを下記のように変更してみてください。

Sub test()
Dim i, j, k As Long
For k = 1 To Worksheets.Count
i = Worksheets(k).UsedRange.Rows.Count
For j = 1 To 7
Worksheets(k).Cells(i, j).Borders(xlEdgeBottom).LineStyle = xlDouble
Next j
Next k
End Sub

これでSheet名に関係なくすべてのSheetの最終行のA～G列に二重下線が表示されると思います。
何度も失礼しました。m(__)m

回答No.2

tom04

こんばんは！
一例です。
こんな感じでよいのですかね？
ごくごく単純にやってみました。

Sub test()
Dim i, j, k As Long
For k = 1 To Worksheets.Count
i = Worksheets("sheet" & k).UsedRange.Rows.Count
For j = 1 To 7
Worksheets("sheet" & k).Cells(i, j).Borders(xlEdgeBottom).LineStyle = xlDouble
Next j
Next k
End Sub

的外れならごめんなさい。m(__)m