エクセル VBA 飛ぶセルの自動連番のつけ方

質問

エクセル　VBA　で添付画像のように１枚に３０までの自動連番、
セルに1～150と入力すれば自動採番で５枚印刷できるような
ＶＢＡをご教示下さい。

番号は001のような３ケタの場合でお願いします。

回答No.5

HohoPapa · ベストアンサー

さらにさらにごめんなさい。
先に示したコードでも動作しますが、
気がかりな記述になっているところがあるので、再掲示します。

Option Explicit

Sub sample3()

　Dim wkL As Integer
　Dim wkC As Integer
　Dim wkSH As Worksheet
　Dim wkNum As Integer

　Set wkSH = ThisWorkbook.Sheets(1)
　wkNum = wkSH.Cells(1, 3).Value

　Do

　　For wkC = 1 To 3
　　　For wkL = 1 To 10
　　　　With wkSH.Cells(wkL * 3, wkC * 3)
　　　　　.NumberFormatLocal = "@"
　　　　　.HorizontalAlignment = xlCenter
　　　　　.VerticalAlignment = xlCenter
　　　　　.Value = Format(wkNum, "000")
　　　　End With
　　　　wkNum = wkNum + 1
　　　Next wkL
　　Next wkC

　　wkSH.PrintOut

　　If wkNum > wkSH.Cells(1, 5).Value Then Exit Do

　Loop

End Sub

お礼

早々のご回答ありがとうございました。
ばっちり起動しました(^O^)

色々と勉強させて頂き大変感謝しております。!(^^)!

回答No.4

HohoPapa

ナンバーリングする部分を中央印字させているようなので
それを加味して再掲示します。

印刷範囲、行高、行幅、背景色、デザインなどの設定は済んでいて、
VBAでやりたいことはナンバーリングと印刷指示だという理解でいいですね？

また、番号の範囲（C1～E1：ナンバーリングする数）は
30の整数倍という条件で良ければ
次のようなコードとなりましょう。

Option Explicit

Sub sample2()

　Dim wkL As Integer
　Dim wkC As Integer
　Dim wkSH As Sheet1
　Dim wkNum As Integer

　Set wkSH = ThisWorkbook.Sheets(1)
　wkNum = wkSH.Cells(1, 3).Value

　Do

　　For wkC = 1 To 3
　　　For wkL = 1 To 10
　　　　With wkSH.Cells(wkL * 3, wkC * 3)
　　　　　.NumberFormatLocal = "@"
　　　　　.HorizontalAlignment = xlCenter
　　　　　.VerticalAlignment = xlCenter
　　　　　.Value = Format(wkNum, "000")
　　　　End With
　　　　wkNum = wkNum + 1
　　　Next wkL
　　Next wkC

　　wkSH.PrintOut

　　If wkNum > wkSH.Cells(1, 5).Value Then Exit Do

　Loop

End Sub

回答No.3

HohoPapa

印刷範囲、行高、行幅、背景色、デザインなどの設定は済んでいて、
VBAでやりたいことはナンバーリングと印刷指示だという理解でいいですね？

また、番号の範囲（C1～E1：ナンバーリングする数）は
30の整数倍という条件で良ければ
次のようなコードとなりましょう。

Option Explicit

Sub sample1()

　Dim wkL As Integer
　Dim wkC As Integer
　Dim wkSH As Sheet1
　Dim wkNum As Integer

　Set wkSH = ThisWorkbook.Sheets(1)
　wkNum = wkSH.Cells(1, 3).Value

　Do

　　For wkC = 1 To 3
　　　For wkL = 1 To 10
　　　　wkSH.Cells(wkL * 3, wkC * 3).Value = "'" & Format(wkNum, "000")
　　　　wkNum = wkNum + 1
　　　Next wkL
　　Next wkC

　　wkSH.PrintOut

　　If wkNum > wkSH.Cells(1, 5).Value Then Exit Do

　Loop

End Sub

回答No.2

SI299792

これ、１５０枚分シートを作って、１ページ30枚になるように調整して、印刷の範囲指定だけをマクロでやったほうがよくないですか。
サイズ等は調整して下さい。
但し、範囲指定でやっているので、１～１を指定しても、１～３が出ます。
PrintOutのコメントを外せば、印刷もされます。

回答No.1

imogasi

割引券部分を
標準モジュールに
Sub test02()
Range("A2:A51") = "割引券"
Range("D2:D51") = "割引券"
Range("G2:G51") = "割引券"
End Sub
１ステートメントでもできるかもしれないが、テスト時間がないので。
ーーー
番号部分を標準モジュールに
Sub test01()
For j = 1 To 3
For i = 2 To 51
Cells(i, (j - 1) * 3 + 3) = (j - 1) * 50 + i - 1
Next i
Next j
End Sub
でやってみて、どうですか。A,B列のセル結合と中央揃えは、VBAでもできるが、手動でやってください。質問のメイン課題ではないだろうから。
ーー
Cells(i, (j - 1) * 3 + 3) =　の(j - 1) * 3 + 3の部分は中学校で学ぶ、数列を代数式で表す訓練の結果です。これは３，６、９列を表したいためこうした。列レイアウトを変えるならこの式を考え直してください。