1目的
2コード
Option Explicit
'============================================================
' モジュール名
' mod提出物採番して外注束作成
'
' Version
' 1.1
'
'【目的】
' 読取シートへ入力した会社ごとの提出件数を、
' 50件単位の外注束へ展開して出力シートへ出力する。
'
'【設計方針】
' ・シートレイアウトはExcel側で管理する。
' ・見出し・書式・列幅はVBAで変更しない。
' ・VBAはデータのみ出力する。
' ・読取順に処理する。
' ・変数は初めて意味を持つブロックで宣言する。
' ・コメントは処理の区切りと、コードだけでは伝わらない
' 設計意図のみ記述する。
'============================================================
Private Enum cNoWs読取
会社名 = 1
件数 = 2
End Enum
Private Enum cNoWs出力
ID = 1
会社名 = 2
件数 = 3
束番号 = 4
開始番号 = 5
終了番号 = 6
End Enum
Sub 出力作成()
'======== 定数 ========
Const 最大束件数 As Long = 50
Const 読取シート名 As String = "入力"
Const 出力シート名 As String = "出力"
Const 読取開始行 As Long = 2
Const 出力開始行 As Long = 2
'======== シート取得 ========
Dim ws読取 As Worksheet
Dim ws出力 As Worksheet
Set ws読取 = Worksheets(読取シート名)
Set ws出力 = Worksheets(出力シート名)
'======== 出力シート初期化 ========
ws出力.Rows(出力開始行 & ":" & ws出力.Rows.Count).ClearContents
'======== 採番初期化 ========
Dim lng現在束番号 As Long
Dim lng現在束残件数 As Long
Dim lng次開始番号 As Long
Dim lng次行ID As Long
Dim rNo出力行 As Long
lng現在束番号 = 1
lng現在束残件数 = 最大束件数
lng次開始番号 = 1
lng次行ID = 1
rNo出力行 = 出力開始行
'======== 読取データを順番に処理 ========
Dim rNo読取最終行 As Long
Dim rNo読取行 As Long
rNo読取最終行 = ws読取.Cells(ws読取.Rows.Count, cNoWs読取.会社名).End(xlUp).Row
For rNo読取行 = 読取開始行 To rNo読取最終行
Dim str会社名 As String
Dim lng会社残件数 As Long
str会社名 = ws読取.Cells(rNo読取行, cNoWs読取.会社名).Value
lng会社残件数 = ws読取.Cells(rNo読取行, cNoWs読取.件数).Value
'会社より50件単位を優先して束を構成する
Do While lng会社残件数 > 0
'======== 今回出力件数を決定 ========
Dim lng今回出力件数 As Long
If lng会社残件数 <= lng現在束残件数 Then
lng今回出力件数 = lng会社残件数
Else
lng今回出力件数 = lng現在束残件数
End If
'======== 開始番号・終了番号を決定 ========
Dim lng終了番号 As Long
lng終了番号 = lng次開始番号 + lng今回出力件数 - 1
'======== 出力 ========
ws出力.Cells(rNo出力行, cNoWs出力.ID).Value = lng次行ID
ws出力.Cells(rNo出力行, cNoWs出力.会社名).Value = str会社名
ws出力.Cells(rNo出力行, cNoWs出力.件数).Value = lng今回出力件数
ws出力.Cells(rNo出力行, cNoWs出力.束番号).Value = lng現在束番号
ws出力.Cells(rNo出力行, cNoWs出力.開始番号).Value = lng次開始番号
ws出力.Cells(rNo出力行, cNoWs出力.終了番号).Value = lng終了番号
'======== 状態更新 ========
lng会社残件数 = lng会社残件数 - lng今回出力件数
lng現在束残件数 = lng現在束残件数 - lng今回出力件数
lng次開始番号 = lng終了番号 + 1
lng次行ID = lng次行ID + 1
rNo出力行 = rNo出力行 + 1
If lng現在束残件数 = 0 Then
lng現在束番号 = lng現在束番号 + 1
lng現在束残件数 = 最大束件数
End If
Loop
Next rNo読取行
'======== 完了 ========
MsgBox "出力が完了しました。"
End Sub
以下claude版
Option Explicit
'============================================================
' モジュール名
' mod提出物採番して外注束作成
'
' Version
' 2.9
'
'【目的】
' 読取シートへ入力した会社ごとの提出件数を、
' 50件単位の外注束へ展開して出力シートへ出力する。
'
'【設計方針】
' ・シートレイアウトはExcel側で管理する。
' ・見出し・書式・列幅はVBAで変更しない。
' ・VBAはデータのみ出力する。
' ・読取順に処理する。
' ・変数は初めて意味を持つブロックで宣言する。
' ・役割（書込み先／読取り元）が異なる行番号は、たとえ同じシートを
' 指していても変数を使い回さず、別の変数名として書き分ける。
' ・行番号変数は「RNo_シート名_役割」の形式で命名し、
' どのシートのどの用途の行番号かを本文だけで判別できるようにする。
' ・データ値の変数も同様に「型_ws_シート名_列名（用途）」の形式で
' 命名し、どのシートのどの列に対応する値かを本文だけで
' 判別できるようにする。
'
'【コメント方針】
' ・コメントは処理の区切り（ステップの節目）や、コードだけでは
' 伝わらない設計意図・判断理由を記述する。
' ・特に、複数の判定や処理が連続していて、それぞれが何をしているか
' 一目で分からない箇所（連続するIf文、If-Elseの分岐など）や、
' ループ・変数宣言・分岐の直前など、コードだけでは目的が
' 伝わりにくい箇所には、一言添える。
' ・変数名や条件式自体が文として読める箇所は、コメントがなくても
' 読み下せることが多いが、他の判断基準を優先してよい。
'
'【出力の粒度について】
' ・「束」は読取順の通し番号に対して50件ごとに機械的に区切られる
' （会社の境界は一切考慮しない）。
' ・出力シートの1行は「束まるごと」ではなく「束×会社」の単位になる。
' 1つの束に複数社が含まれる場合や、1社が複数束にまたがる場合は、
' 会社が変わる箇所・束が変わる箇所のどちらでも行を分ける。
'
'【採番方式について】
' ・通し番号・束番号・束内番号は、いずれも割り算や逆算によらず、
' 作業シートへの展開と同時にカウンタを1件ずつ加算（必要に応じて
' リセット）することで採番する。
' ・開始番号・終了番号は、束内番号ではなく全体を通した通し番号を
' 使う。これにより、あるデータが全体の何件目から何件目に
' あたるかを、束をまたいでも一意に追跡できる。
' ・束枝番は「塊（会社×束の塊）が変わったかどうか」という、
' 塊が確定して初めて定義できる情報である。そのため作業シート
' （1件単位）の段階では採番せず、出力シート（塊単位）が
' 完成した後にステップ3として改めて上から見て採番する。
' 判定は単純で、出力シートを上から見て、束番号が1行上と同じ
' なら束枝番を1加算、違えば1にリセットする。
'============================================================
'読取シートの列番号
Private Enum CNoWs読取
会社名 = 1
件数 = 2
End Enum
'作業シートの列番号
Private Enum CNoWs作業
通し番号 = 1
会社名 = 2
束番号 = 3
束内番号 = 4
End Enum
'出力シートの列番号
Private Enum CNoWs出力
ID = 1
会社名 = 2
件数 = 3
束番号 = 4
束枝番 = 5
開始番号 = 6
終了番号 = 7
End Enum
Sub 出力作成()
'======== 定数 ========
'読取シート
Const str読取シート名 As String = "読取"
Const RNo_ws読取_開始行 As Long = 2
'作業シート
Const str作業シート名 As String = "作業"
Const RNo_ws作業_開始行 As Long = 2
'出力シート
Const str出力シート名 As String = "出力"
Const RNo_ws出力_開始行 As Long = 2
Const lng最大束件数 As Long = 50
'======== シート取得 ========
Dim ws読取 As Worksheet
Dim ws作業 As Worksheet
Dim ws出力 As Worksheet
Set ws読取 = Worksheets(str読取シート名)
Set ws作業 = Worksheets(str作業シート名)
Set ws出力 = Worksheets(str出力シート名)
ws作業.Rows(RNo_ws作業_開始行 & ":" & ws作業.Rows.Count).ClearContents
ws出力.Rows(RNo_ws出力_開始行 & ":" & ws出力.Rows.Count).ClearContents
'======== ステップ1：会社名を件数分だけ作業シートへ展開し、束番号・束内番号も同時に採番 ========
' 1行書き込むたびに、通し番号・束内番号を1ずつ進める。
' 束内番号が50を超えたら、束番号を1つ進めて束内番号を1に戻す。
Dim RNo_ws読取_最終行 As Long
RNo_ws読取_最終行 = ws読取.Cells(ws読取.Rows.Count, CNoWs読取.会社名).End(xlUp).Row
Dim RNo_ws作業_書込行 As Long
RNo_ws作業_書込行 = RNo_ws作業_開始行
'通し番号・束番号・束内番号のカウンタを初期化する
Dim lng_ws作業_通し番号 As Long
lng_ws作業_通し番号 = 0
Dim lng_ws作業_束番号 As Long
Dim lng_ws作業_束内番号 As Long
lng_ws作業_束番号 = 1
lng_ws作業_束内番号 = 0
'読取シートを1行ずつ、会社の登場順に処理する
Dim RNo_ws読取_読取行 As Long
For RNo_ws読取_読取行 = RNo_ws読取_開始行 To RNo_ws読取_最終行
Dim str_ws読取_会社名 As String
Dim lng_ws読取_件数 As Long
str_ws読取_会社名 = ws読取.Cells(RNo_ws読取_読取行, CNoWs読取.会社名).Value
lng_ws読取_件数 = ws読取.Cells(RNo_ws読取_読取行, CNoWs読取.件数).Value
'1社分の件数だけ、作業シートへ1件ずつ展開する
Dim i As Long
For i = 1 To lng_ws読取_件数
lng_ws作業_通し番号 = lng_ws作業_通し番号 + 1
lng_ws作業_束内番号 = lng_ws作業_束内番号 + 1
If lng_ws作業_束内番号 > lng最大束件数 Then
lng_ws作業_束番号 = lng_ws作業_束番号 + 1
lng_ws作業_束内番号 = 1
End If
ws作業.Cells(RNo_ws作業_書込行, CNoWs作業.通し番号).Value = lng_ws作業_通し番号
ws作業.Cells(RNo_ws作業_書込行, CNoWs作業.会社名).Value = str_ws読取_会社名
ws作業.Cells(RNo_ws作業_書込行, CNoWs作業.束番号).Value = lng_ws作業_束番号
ws作業.Cells(RNo_ws作業_書込行, CNoWs作業.束内番号).Value = lng_ws作業_束内番号
RNo_ws作業_書込行 = RNo_ws作業_書込行 + 1
Next i
Next RNo_ws読取_読取行
Dim lng総件数 As Long
lng総件数 = lng_ws作業_通し番号
'======== ステップ2：作業シートを上から転記し、会社名か束番号が変わったら出力行を改める ========
' 出力1行＝「束×会社」の単位。会社の境界・束の境界のどちらでも区切る。
' 束枝番はこの時点ではまだ振らない（ステップ3でまとめて振る）。
'出力行番号・出力IDのカウンタを初期化する
Dim RNo_ws出力_書込行 As Long: RNo_ws出力_書込行 = RNo_ws出力_開始行
Dim lng_ws出力_ID As Long: lng_ws出力_ID = 1
'「同じ会社」かつ「同じ束番号」が連続している塊の先頭行。
'塊の終わりは読み進めれば都度わかるが、始まりは
'前の区切りの次まで遡らないとわからないため保持しておく。
Dim RNo_ws作業_区間開始行 As Long: RNo_ws作業_区間開始行 = RNo_ws作業_開始行
Dim RNo_ws作業_読取行 As Long
For RNo_ws作業_読取行 = RNo_ws作業_開始行 To RNo_ws作業_開始行 + lng総件数 - 1
Dim is改行予定 As Boolean
is改行予定 = False
'最終行に達したら、無条件で塊の区切りとする
If RNo_ws作業_読取行 = RNo_ws作業_開始行 + lng総件数 - 1 Then is改行予定 = True
'次の行で会社が変わるなら、そこで塊を区切る
If ws作業.Cells(RNo_ws作業_読取行 + 1, CNoWs作業.会社名).Value <> ws作業.Cells(RNo_ws作業_区間開始行, CNoWs作業.会社名).Value Then is改行予定 = True
'次の行で束番号が変わるなら、そこでも塊を区切る
If ws作業.Cells(RNo_ws作業_読取行 + 1, CNoWs作業.束番号).Value <> ws作業.Cells(RNo_ws作業_区間開始行, CNoWs作業.束番号).Value Then is改行予定 = True
If is改行予定 Then
ws出力.Cells(RNo_ws出力_書込行, CNoWs出力.ID).Value = lng_ws出力_ID
ws出力.Cells(RNo_ws出力_書込行, CNoWs出力.会社名).Value = ws作業.Cells(RNo_ws作業_区間開始行, CNoWs作業.会社名).Value
ws出力.Cells(RNo_ws出力_書込行, CNoWs出力.件数).Value = RNo_ws作業_読取行 - RNo_ws作業_区間開始行 + 1
ws出力.Cells(RNo_ws出力_書込行, CNoWs出力.束番号).Value = ws作業.Cells(RNo_ws作業_区間開始行, CNoWs作業.束番号).Value
ws出力.Cells(RNo_ws出力_書込行, CNoWs出力.開始番号).Value = ws作業.Cells(RNo_ws作業_区間開始行, CNoWs作業.通し番号).Value
ws出力.Cells(RNo_ws出力_書込行, CNoWs出力.終了番号).Value = ws作業.Cells(RNo_ws作業_読取行, CNoWs作業.通し番号).Value
lng_ws出力_ID = lng_ws出力_ID + 1
RNo_ws出力_書込行 = RNo_ws出力_書込行 + 1
RNo_ws作業_区間開始行 = RNo_ws作業_読取行 + 1
End If
Next RNo_ws作業_読取行
'======== ステップ3：出力シートを上から見て、束番号が1行上と同じなら束枝番を加算 ========
' 出力シートは既に「束×会社」の塊単位で1行にまとまっているため、
' ここでは束番号の変化を見るだけで枝番が決まる。
' 直前の束番号の初期値は0（実在しない束番号）にしておくことで、
' 1行目は必ず「変わった」と判定され、束枝番が1から始まる。
Dim RNo_ws出力_最終行 As Long
RNo_ws出力_最終行 = RNo_ws出力_書込行 - 1
'束枝番・直前の束番号のカウンタを初期化する
Dim lng_ws出力_束枝番 As Long
lng_ws出力_束枝番 = 0
Dim lng_ws出力_直前の束番号 As Long
lng_ws出力_直前の束番号 = 0
Dim RNo_ws出力_採番行 As Long
For RNo_ws出力_採番行 = RNo_ws出力_開始行 To RNo_ws出力_最終行
Dim lng_ws出力_現在の束番号 As Long
lng_ws出力_現在の束番号 = ws出力.Cells(RNo_ws出力_採番行, CNoWs出力.束番号).Value
If lng_ws出力_現在の束番号 = lng_ws出力_直前の束番号 Then
'同じ束の中がまだ続いているので、枝番を1つ進める
lng_ws出力_束枝番 = lng_ws出力_束枝番 + 1
Else
'新しい束に入ったので、枝番を1からリセットする
lng_ws出力_束枝番 = 1
lng_ws出力_直前の束番号 = lng_ws出力_現在の束番号
End If
ws出力.Cells(RNo_ws出力_採番行, CNoWs出力.束枝番).Value = lng_ws出力_束枝番
Next RNo_ws出力_採番行
'======== 完了 ========
MsgBox "出力が完了しました。"
End Sub
3参考
chatGPT
