マクロの改ページの追加について。

質問

下記コードに、E列を上から見て値が変わったら改ページ、を追加したいのですが、上手くできません。
A列、D列のみの下記コードでは成功します。

ちなみにE列は日付なんですが、A列D列同様にコードを書き足すだけではダメなんでしょうか？？

以前こちらで質問させて頂いて、回答を頂いたコードで、私自身完璧に内容を理解できていないので、追加の仕方もわからない状況です。

よろしくお願い致します。

Sub test()
Dim rng As Range
Dim objA As New Collection
Dim objD As New Collection
Dim strA As String
Dim strD As String
Dim blnBreak As Boolean

' 改ページを全て解除
Activesheet.ResetAllPageBreaks

Activesheet.PageSetup.PrintArea ="$A:$K"

For Each rng In Range("A:A")
strA = CStr(rng.Value)
strD = CStr(rng.Offset(0, 3).Value)

' コレクションに追加（同じデータはスキップする）
On Error Resume Next
objA.Add strA, strA
objD.Add strD, strD
On Error GoTo 0

If objA.Count = 2 Then
' A列の 2つ目のコレクションで改ページ
blnBreak = True

' コレクションをリセット
Set objA = New Collection
Set objD = New Collection

objA.Add strA, strA
objD.Add strD, strD
Else
If objD.Count = 4 Then
' D列の 4つ目のコレクションで改ページ
blnBreak = True

' コレクションをリセット
Set objA = New Collection
Set objD = New Collection

objA.Add strA, strA
objD.Add strD, strD
Else
blnBreak = False
End If
End If

' 改ページ挿入
If blnBreak Then
Activesheet.HPageBreaks.Add rng
End If
Next
End Sub

回答No.5

masnoske · ベストアンサー

No.2 です．
今後，他の条件が加わることも想定して，コレクションをリセットする処理を ResetCollプロシージャにまとめました．
また，パラメータが 6つもありゴチャゴチャするので，モジュールの外に定義しました．

' ----------------------- ここから -----------------------------
Private objA As New Collection
Private objD As New Collection
Private objE As New Collection
Private strA As String
Private strD As String
Private strE As String

Sub test()
Dim rng As Range
Dim blnBreak As Boolean

' 改ページを全て解除
ActiveSheet.ResetAllPageBreaks

ActiveSheet.PageSetup.PrintArea = "$A:$K"

For Each rng In Range("A:A")
' A列に空白が見つかったら終了（A列の途中に空白がある場合は次行を削除してください）
If rng.Value = "" Then Exit For

strA = CStr(rng.Value)
strD = CStr(rng.Offset(0, 3).Value)
strE = CStr(rng.Offset(0, 4).Value)

' コレクションに追加（同じデータはスキップする）
On Error Resume Next
objA.Add strA, strA
objD.Add strD, strD
objE.Add strD, strE
On Error GoTo 0

If objA.Count = 2 Then
' A列の 2つ目のコレクションで改ページ
blnBreak = True

' コレクションをリセット
Call ResetColl
Else
If objD.Count = 4 Then
' D列の 4つ目のコレクションで改ページ
blnBreak = True

' コレクションをリセット
Call ResetColl
Else
If objE.Count = 2 Then
' E列の 2つ目のコレクションで改ページ
blnBreak = True

' コレクションをリセット
Call ResetColl
Else
blnBreak = False
End If
End If
End If

' 改ページ挿入
If blnBreak Then
ActiveSheet.HPageBreaks.Add rng
End If
Next
End Sub

Private Sub ResetColl()
' コレクションをリセット
Set objA = New Collection
Set objD = New Collection
Set objE = New Collection

objA.Add strA, strA
objD.Add strD, strD
objE.Add strE, strE
End Sub
' ----------------------- ここまで -----------------------------

No.4 さんの Orを使った方法だと優先順位がないので，想定される動作にならないように思います（違っていたらごめんなさい）．
今後追加される場合は，以下の点に気を付けてトライしてみてください．

(1) 基本的に objA，strAと同じように追加する．
(2) rng.Offset(0, x) で，x はA列から何列ずれているかを考える．
(3) If 分の構造に注意する．
　以下のように入れ子構造で優先順位を設定してください．

If 最優先される条件 Then
blnBreak = True
Call ResetColl
Else
If 2番目に優先される条件 Then
blnBreak = True
Call ResetColl
Else
If 3番目に優先される条件 Then
blnBreak = True
Call ResetColl
Else
If 4番目に優先される条件 Then
blnBreak = True
Call ResetColl
Else
' 最後の条件を満たさなかった場合
blnBreak = False
End If
End If
End If
End If

回答No.4

HohoPapa

質問文に提示されたコード、それに手を入れたNo.3のコード
双方とも、
課題シートの最終行（たぶん1048576行目）までチェックしているため
若干もたつくコードです。

また、
A列のセルを全数チェックするところで
For Each rng In Range("A:A")　のコードを使っているため
（経験上問題になったことはないものの）
厳密には、1行目から下方向に順番に処理していることが担保されていません。
詳しくは、よかったら
https://www.exvba.com/2260/
を読んでみてください。

そこで手直しを加え、再ポストします。

なお、示したコードは、
シートの1行目の何れかのセルに値が埋まっている場合のコードです。
（1行目が全数空欄の場合を想定していません。）
1行目が全数空欄の場合はお知らせください。
更に手直しします。

Sub test4()

　　Dim objA As New Collection
　　Dim objD As New Collection
　　Dim objE As New Collection
　　Dim strA As String
　　Dim strD As String
　　Dim strE As String
　　Dim blnBreak As Boolean
　　Dim RowCnt As Long

　　' 改ページを全て解除
　　ActiveSheet.ResetAllPageBreaks

　　ActiveSheet.PageSetup.PrintArea = "$A:$K"

　　For RowCnt = 1 To ActiveSheet.UsedRange.Rows.Count
　　　　strA = CStr(Cells(RowCnt, 1).Value)
　　　　strD = CStr(Cells(RowCnt, 1).Offset(0, 3).Value)
　　　　strE = CStr(Cells(RowCnt, 1).Offset(0, 4).Value)

　　　　' コレクションに追加（同じデータはスキップする）
　　　　On Error Resume Next
　　　　objA.Add strA, strA
　　　　objD.Add strD, strD
　　　　objE.Add strE, strE
　　　　On Error GoTo 0

　　　　If ((objA.Count = 2) Or _
　　　　　　(objD.Count = 4) Or _
　　　　　　(objE.Count = 2)) Then
　　　　　　blnBreak = True

　　　　　　' コレクションをリセット
　　　　　　Set objA = New Collection
　　　　　　Set objD = New Collection
　　　　　　Set objE = New Collection

　　　　　　objA.Add strA, strA
　　　　　　objD.Add strD, strD
　　　　　　objE.Add strE, strE
　　　　Else
　　　　　blnBreak = False
　　　　End If

　　　　' 改ページ挿入
　　　　If blnBreak Then
　　　　　　ActiveSheet.HPageBreaks.Add Cells(RowCnt, 1)
　　　　End If
　　Next

　　MsgBox "終わったよ"

End Sub

お礼

ありがとうございます！！

思い通りに改ページが挿入され、助かりました！
やはり、以前よりマクロが完了するまでのスピードが速くなった気がします。

メッセージボックスを使用したことがなく、
完了したときホッコリしました＾＾

また、何かありましたらよろしくお願いします。

回答No.3

HohoPapa

以下のコードで行けるだろうと思います。

Sub test2()
　　Dim rng As Range
　　Dim objA As New Collection
　　Dim objD As New Collection
　　Dim objE As New Collection
　　Dim strA As String
　　Dim strD As String
　　Dim strE As String
　　Dim blnBreak As Boolean

　　' 改ページを全て解除
　　ActiveSheet.ResetAllPageBreaks

　 ActiveSheet.PageSetup.PrintArea = "$A:$K"

　　For Each rng In Range("A:A")
　　　　strA = CStr(rng.Value)
　　　　strD = CStr(rng.Offset(0, 3).Value)
　　　　strE = CStr(rng.Offset(0, 4).Value)

　　　　' コレクションに追加（同じデータはスキップする）
　　　　On Error Resume Next
　　　　objA.Add strA, strA
　　　　objD.Add strD, strD
　　　　objE.Add strE, strE
　　　　On Error GoTo 0

　　　　If ((objA.Count = 2) Or _
　　　　　　(objD.Count = 4) Or _
　　　　　　(objE.Count = 2)) Then
　　　　　　blnBreak = True

　　　　　　' コレクションをリセット
　　　　　　Set objA = New Collection
　　　　　　Set objD = New Collection
　　　　　　Set objE = New Collection

　　　　　　objA.Add strA, strA
　　　　　　objD.Add strD, strD
　　　　　　objE.Add strE, strE
　　　　Else
　　　　　blnBreak = False
　　　　End If

　　　　' 改ページ挿入
　　　　If blnBreak Then
　　　　　　ActiveSheet.HPageBreaks.Add rng
　　　　End If
　　Next
End Sub

回答No.2

masnoske

No.1 です。
先の回答は忘れてください。
E列の改行条件が判りません。
A列、B列、E列の改行条件を提示してください。

補足

いつもありがとうございます。

全て上から下へ順に見た時です。
A列の値が変わったら改ページ、
D列の値が3回変わったら改ページ、
E列はA列D列の条件をクリアした上で、プラスの条件として、数値(日付)が変わったら改ページ、です。

先ほど頂いた回答でやってみたのですが、E列の改ページ条件が最優先にされてしまったのか、うまく改ページが入りませんでした。

優先順位はA→D→E列の順番です。
Aが最優先です。

文章でわかりずらくて、申し訳ないです。
何かありましたら答えますので、よろしくお願い致します。

回答No.1

masnoske

A列，D列と同じように E列を追加すれば動くと思いますが．
以下の部分だけは，Offset関数の意味が判っていないと，どうすれば良いのか判らないと思います．

strA = CStr(rng.Value)
strD = CStr(rng.Offset(0, 3).Value)

ここで変数rngには，A列のセルが逐次ループで割り当てられます．
Offset関数は，基準セルから行列方向にずらしたセルを得る関数です．
なので，下記のコードでは rngに A列のセルがあり，Offset(0, 3)はそのセルから行方向に 0行，列方向に 3列ずらしたセル．．．つまり D列のセルになります．

なので E列のセルであれば，rng.Offset(0, 4)になりますので，
strE = CStr(rng.Offset(0, 4).Value)
を追加すれば良いです．

それ以外は objA，strA と同じように追加すれば良いです．