Excel VBAを用いて顧客リストから一括で通知印刷する設定で、同じ宛先の人に対し、まとめて契約IDを記載する

Question

Excel VBAを用いて、以下のような顧客リストを使用し、同じ宛先（同じ通し番号）の人に対し、契約IDを1つの通知にまとめて記載した状態で、印刷をしたいです。
通知のフォーマットは、同じ宛先の人（通し番号）に対し、契約ID最大10個までを1つの通知に印刷できるような仕様になっています。

1列目を通し番号とし、同じ宛先の人は同じ通し番号になるようにしています。

1 契約ID　Aさん　住所
1 契約ID　Aさん　住所
2 契約ID　Bさん　住所
3 契約ID　Cさん　住所
3 契約ID　Cさん　住所
3 契約ID　Cさん　住所

※契約IDは、契約単位で異なるため、全て異なります。

複数人で分担して印刷するため、顧客リストのセルAZ3に印刷開始行、顧客リストのセルBA3に印刷終了行を手入力すると、印刷開始行から印刷終了行までの間の顧客リストを一括印刷する設定にしています。

通知のCells(2,36)に契約IDを転記し、通知の宛先部分に顧客リストからVLOOKUPで、Cells(2,36)の顧客を探し、住所を引っ張ってくる設定にしています。

If関数で通し番号が同一の場合は、Cells(2,36)の隣のセルに契約IDを転記する。この作業を最大10個の契約IDで繰り返す。異なる場合は、通知を印刷し、セルをクリアして次の顧客の通知を印刷する。という設定にしようと考えています。

しかし、ループ処理が上手くいかず、Aさんをひたすら印刷してしまいます。
どこを修正したら上手くループできるのか、Do While やDo Until等色々試しましたが分からないため、教えていただけるとありがたいです。

Sub 通知印刷()

 Dim i As Integer
 Dim Start_Point As Integer
 Dim End_Point As Integer
 Dim k As Integer
 
Start_Point = Worksheets("顧客リスト").Range("AZ3").Value
End_Point = Worksheets("顧客リスト").Range("BA3")

For k = Start_Point To End_Point Step CStr(k)
 
 Worksheets("通知").Cells(2,36) = Worksheets("顧客リスト").Cells(CStr(k), 2)
 
 For i = 1 To 10
 
 If Worksheets("顧客リスト").Cells(CStr(k), 1) = Worksheets("顧客リスト").Cells(CStr(k) + CStr(i), 1) Then
 
 Worksheets("通知").Cells(2, 36 + CStr(i)) = Worksheets("顧客リスト").Cells(CStr(k) + CStr(i), 2)
 
 Else
 
 Worksheets("通知").PrintOut
 
 Worksheets("通知").Range("AJ2:AS2").ClearContents

 End If
 
 Next i
 
Next k

End Sub

Comments

[jinoji]

シート名がたくさん出てきますが、関係性がわかりませんでした。

契約IDの転記先は(36,2)と(2, 36)のどっちが正しいですか。

[mkmigmyuch]

jinojiさん、毎回助けてくださり、本当にありがとうございます。
jinojiさんのおかげで私の仕事が成り立っており、大変感謝しています。
直したと思っていたのですが、回線が悪く、反映していませんでした。
分かりづらくしてしまい、すみませんでした。

修正致しましたので、ご確認いただけると大変ありがたいです。
(2,36)が正で、シートは通知、顧客リストの2種類のみです。

Answer 1

テストとかしていませんが、雰囲気としてはこんな感じかなと思いました。いかがでしょうか。

    Dim i As Integer
    Dim Start_Point As Integer
    Dim End_Point As Integer
    Dim k As Integer
    
    Dim wsK As Worksheet
    Set wsK = Worksheets("顧客リスト")
    Dim wsT As Worksheet
    Set wsT = Worksheets("通知")
    
    With wsK
        Start_Point = .Range("AZ3").Value
        End_Point = .Range("BA3").Value
        
        k = Start_Point
        Do While k < End_Point
            wsT.Cells(2, 36) = wsK.Cells(k, 2)
            For i = 1 To 10
                If wsK.Cells(k, 1) = wsK.Cells(k + i, 1) Then
                    wsT.Cells(2, 36 + i) = wsK.Cells(k + i, 2)
                Else
                    wsT.PrintOut
                    wsT.Range("AJ2:AS2").ClearContents
                    Exit For
                End If
            Next
            k = k + i
        Loop
    End With

Comments

[mkmigmyuch]

回答作成いただきありがとうございます。
試させていただいたところ、終わりの部分を< End_Point+1にして、ループ処理が想像通りに動いてくれました！
ありがとうございましたm(__)m
ループ処理の文章を1から考えるのが苦手なので、教えていただいた文章を参考に、考え方をもっと勉強したいと思います。
大変助かりました。いつも本当にありがとうございます。