
アンケート案件 x 乱数のバリアブル・プリント by ChatGPT & perplexity
最近自治体関係でやっているアンケート調査の案件が忙しく、また複数件重なって来ており大変な毎日です。
今回取り上げるのは表1にバリアブル印字のある仕事で、4桁の数字の乱数を生成し表1に入れて欲しいという顧客指示。短納期で余裕がなかったのでAIの手を借りて乱数生成マクロを自作した話です。
印刷仕様:
①A4仕上がり10p墨1/1平綴じ+巻三つ折り
※表1に乱数4桁数字
②送信用封筒 長3(顧客支給)料金別納マーク+宛名をPODで印字
③返信用封筒 長3クラフト70gテープスチック 墨1/0 巻三つ折り
以上3000セット封入封緘して局出し
下版8/28AM
局出し9/4完了
作業日数5日営業日(5営業日目に局出しまで)
※10p3000部はオフセット印刷し、後で表1をPODで追い刷りし、丁合して中綴じ機で平綴じします。印刷会社じゃない人は分からんよね^^;
※平綴じはペラ丁合なんで納期キツイです(泣)でも可変が乱数なので、ヤレ管理不要なのが不幸中の幸い。また弊社封入機があるので、封入の方が製本より早く、こんな時助かります。


でメインの乱数生成ですが、エクセルファイル.xlsmにVBAで書きました。


vbaのコードです。
Sub GenerateRandomNumbers()
Dim NumCells As Long
Dim MinValue As Long
Dim MaxValue As Long
Dim i As Long
Dim RndNumber As Long
Dim Cell As Range
Dim RandomNumbers As New Collection
Dim MaxDigits As Long
' Sheets(1)のA列をクリア
Sheets(1).Columns("A:A").ClearContents
Sheets(2).Columns("A:A").ClearContents
' パラメータを設定
NumCells = Range("C1").Value ' 生成する乱数の数
MinValue = Range("C2").Value ' 乱数の最小値
MaxValue = Range("C3").Value ' 最大桁数を求めるための最大値
MaxDigits = Len(CStr(MaxValue)) ' 最大桁数
' 重複のない乱数を生成
Do While RandomNumbers.Count < NumCells
RndNumber = WorksheetFunction.RandBetween(MinValue, MaxValue)
On Error Resume Next
RandomNumbers.Add RndNumber, CStr(RndNumber)
On Error GoTo 0
Loop
' 生成した乱数をセルに出力
i = 1
For Each Cell In Sheets(1).Range("A1:A" & NumCells)
Cell.Value = RandomNumbers.Item(i)
i = i + 1
Next Cell
' 乱数を最大桁数に合わせて左0埋めしてSheets(2)に出力
i = 1
For Each Cell In Sheets(1).Range("A1:A" & NumCells)
' Format関数で左0埋め
Sheets(2).Cells(i, 1).NumberFormat = "@" ' セルをテキスト形式に設定
Sheets(2).Cells(i, 1).Value = Format(Cell.Value, String(MaxDigits, "0"))
i = i + 1
Next Cell
End Sub
