以下マクロの処理を最終行まで処理されるようにしたいです。 以下マクロですと最初の5行のA～D列をそれ

以下マクロの処理を最終行まで処理されるようにしたいです。

以下マクロですと最初の5行のA～D列をそれぞれ結合して左上に寄せる処理をしてます。

これを5行おきに最終行まで処理させたいです。

5行のうち2～5行目は空白です。


' merge Macro
'

'
Range("A7:A11,B7:B11,C7:C11,D7:D11").Select
Range("D7").Activate
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
End Sub

No.4 回答者： fujillin 回答日時： 2023/12/07 18:24

こんにちは

すでに回答がありますけれど、以下はご参考までに。
（各列について、最終行までを処理します）

Sub Q13674218()
Dim rw As Long, col As Long

rw = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
rw = Application.Max(rw - 7, 1)

With Range("A7:D7").Resize(rw)
.UnMerge
.IndentLevel = 0
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
End With

Application.DisplayAlerts = False
For col = 1 To 4
For rw = 7 To Cells(Rows.Count, col).End(xlUp).Row Step 5
Cells(rw, col).Resize(5).Merge
Next rw
Next col
Application.DisplayAlerts = True
End Sub

No.3 回答者： Qchan1962 回答日時： 2023/12/07 16:26

＃２です

Range("A7:A11,B7:B11,C7:C11,D7:D11")　が
Range("A7:D11")・・・・とんでもない回答ですみません
試さないから間違える・・ですね

Dim i As Long
For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row Step 5
With Range("A" & i).Resize(5, 4)
　部分を

Dim i As Long
Dim n As Integer
For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row Step 5
n = i + 4
With Range("A" & i & ":A" & n & ",B" & i & ":B" & n & ",C" & i & ":C" & n & ",D" & i & ":D" & n)

とか・・・かっこ悪すぎなら

' merge Macro
'

'
Dim i As Long
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row - 7 Step 5
With Range("A6:A10,B6:B10,C6:C10,D6:D10").Offset(i)
.Merge
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
End With
Next
End Sub

とか・・・


二重ループで範囲を繰り返しみたいな

Sub test02()
Dim i As Long
Dim n As Integer
For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row Step 5
For n = 1 To 4
With Cells(i, n).Resize(5)
.Merge
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
End With
Next
Next
End Sub

＃２は参考になる部分があればよいのですが、勘違いで誤回答です

No.2 回答者： Qchan1962 回答日時： 2023/12/07 15:21

まず記録マクロをまとめます

通常、処理は上から下に実行されるので同じプロパティへの設定は下の方が最終実行されますので重複している処理をまとめると・・
' merge Macro
'

'
Range("A7:A11,B7:B11,C7:C11,D7:D11").Select

With Selection
.Merge
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
End Sub
となります

さらに今回省略可能な設定を省略すると
' merge Macro
'

'
Range("A7:A11,B7:B11,C7:C11,D7:D11").Select
With Selection
.Merge
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
End With
End Sub
さらにさらにSelect::Selection　
Range("A7:A11,B7:B11,C7:C11,D7:D11")　::　Range("A7:D11")
をまとめて書くと
Sub test()
With Range("A7:D11")
.Merge
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
End With
End Sub
となります・・・（Selectはされませんが５行にまとまりました）

最終行まで5行おき（解釈が・・・）
カウント変数などを使い繰り返し処理が必要になります

範囲を変えていくのに扱いやすい書き方に変えます（一例）
With Range("A7:D11")＝＝With Range("A7").Resize(5, 4)

最終行を取得します
＞5行のうち2～5行目は空白です。
１行目には値があるという事ですね　列の掲示はありませんが　A列とします
Cells(Rows.Count, 1).End(xlUp).Row　　：最下行の行番号

5行おきに　A7の次はA12という事でしょうか
Dim i As Long
For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row Step 5
スタート7で　Step 5で繰り返しごとに５進む　7＞12＞17＞＞＞＞
変数iを使って範囲を特定、書式プロパティを設定　繰り返し処理をすると

Dim i As Long
For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row Step 5
With Range("A" & i).Resize(5, 4)
.Merge
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
End With
Next
End Sub

のようになります（一例）

With Range("A" & i).Resize(5, 4)は
With Cells(i, 1).Resize(5, 4)や
With Range(Cells(i, 1), Cells(i + 4, 4))　などなど書き方があります

No.1 回答者： もちからぼたもち 回答日時： 2023/12/07 14:36

Rangeの中身は文字列なので書式を守れば数値部分を自由に変数に置き換えできます。