ねらい：番号ルールを「人の勘」から「VBAの型」に変える
現場で一番モメやすいのが「番号」です。
伝票番号
案件番号
申請番号
問い合わせID
これを人が手入力で振っていると、
同じ番号を二重に使ってしまう
飛び番・欠番が出る
日付や部署コードの付け方がバラバラになる
みたいな“じわじわ効いてくるトラブル”が必ず出ます。
採番自動ツールのゴールは、こうです。
番号のルール（フォーマット）をきちんと決める。
そのルールに従って、VBA が「次の番号」を自動で返す。
人は「ボタンを押す／セルを選ぶ」だけで、正しい番号が入る。
この「番号の決め方」を“超再利用部品”としてテンプレ化しておくと、
どんなシートでも「番号だけは絶対にブレない」状態を作れます。
基本設計：番号の「型」を先に決める
よくある採番パターンを分解してみる
まず、番号のパターンをざっくり分けておきます。
1つ目は「単純連番」です。
000001, 000002, 000003, …
1, 2, 3, …
2つ目は「プレフィックス＋連番」です。
REQ-000001
A-001, A-002, …
3つ目は「日付＋連番」です。
20250101-001
2025-01-001（2025年1月の1件目）
4つ目は「複数キー＋連番」です。
部署コード＋日付＋連番（例：HR-202501-001）
顧客コードごとに連番（C0001-001, C0001-002, C0002-001, …）
実務でよく使うのは、このあたりです。
この「型」を意識しておくと、VBA側の設計が一気に楽になります。
ここでは、まず一番基本の「単純連番」と「日付＋連番」をテンプレ化し、
そのあと「キーごとに連番」の応用まで持っていきます。
単純連番テンプレ：一覧の最終行から「次の番号」を決める
連番を振る対象シートの前提
まずは、こんな一覧を想定します（シート名：Requests）。
A列：No（採番する列）
B列：申請日
C列：申請者
D列：内容
No 列には、1, 2, 3, … と連番を振りたい。
新しい行を追加するときに、「次の番号」を自動で入れたい。
このときの一番シンプルな考え方は、
No 列の最終行の値を見て、それに +1 したものを返す
です。
「次の番号」を返す関数（単純連番）
' ModSeq_Simple.bas
Option Explicit
Public Function GetNextSeq(ByVal ws As Worksheet, ByVal colNo As Long) As Long
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, colNo).End(xlUp).Row
If lastRow < 2 Then
GetNextSeq = 1
Else
Dim lastVal As Variant
lastVal = ws.Cells(lastRow, colNo).Value
If IsNumeric(lastVal) Then
GetNextSeq = CLng(lastVal) + 1
Else
GetNextSeq = 1
End If
End If
End Function
ここでの重要ポイントを深掘りします。
採番列の最終行は「データの最後の行」です。
ヘッダが1行目にある前提で、2行目以降を見ています。
最終行の値が数値でなければ（空欄や文字列なら）、安全側に倒して 1 を返しています。
この関数は「番号の中身（桁数やゼロ埋め）」までは気にしません。
あくまで「次の数値」を返すだけです。
ゼロ埋めやプレフィックスを付ける関数
次に、「見た目の番号」を作る関数を用意します。
Public Function FormatSeq(ByVal seq As Long, _
Optional ByVal digits As Long = 6, _
Optional ByVal prefix As String = "") As String
Dim fmt As String
fmt = String(digits, "0")
FormatSeq = prefix & Format(seq, fmt)
End Function
例えば、
FormatSeq(1) → “000001”FormatSeq(23, 4) → “0023”FormatSeq(5, 4, "REQ-") → “REQ-0005”
のように使えます。
実際にシートに番号を振る Sub
Public Sub AssignNextNo_ToNewRow()
Dim ws As Worksheet
Set ws = Worksheets("Requests")
Dim nextRow As Long
nextRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
Dim seq As Long
seq = GetNextSeq(ws, 1)
Dim noStr As String
noStr = FormatSeq(seq, 6, "REQ-")
ws.Cells(nextRow, "A").Value = noStr
ws.Cells(nextRow, "B").Value = Date
ws.Activate
ws.Cells(nextRow, "C").Select
End Sub
この Sub をボタンに割り当てておけば、
ボタンを押す
新しい行が1行追加される（No と申請日が入る）
カーソルが申請者のセルに移動する
という“新規行追加＋採番”の流れが一発でできます。
日付＋連番テンプレ：日ごとに番号をリセットする
「日付ごとに 001 から始まる」番号の考え方
次は、こういう番号を作りたいケースです。
20250101-001
20250101-002
20250102-001
つまり、「日付が変わったら連番をリセット」したい。
このときの考え方は、
今日の日付をキーにして、その日付の番号の最大値を探す
見つかった最大値に +1 したものを「今日の次の番号」とする
番号の見た目は「yyyymmdd-xxx」のように組み立てる
です。
日付＋連番の「次の番号」を返す関数
' ModSeq_Date.bas
Option Explicit
Public Function GetNextDateSeq(ByVal ws As Worksheet, _
ByVal colNo As Long, _
ByVal targetDate As Date) As Long
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, colNo).End(xlUp).Row
Dim maxSeq As Long
maxSeq = 0
Dim r As Long
For r = 2 To lastRow
Dim v As Variant
v = ws.Cells(r, colNo).Value
If Not IsEmpty(v) Then
Dim s As String
s = CStr(v)
If Len(s) >= 12 Then
Dim dPart As String
dPart = Left$(s, 8)
Dim seqPart As String
seqPart = Mid$(s, 10)
If IsDate(Left$(dPart, 4) & "/" & Mid$(dPart, 5, 2) & "/" & Right$(dPart, 2)) Then
Dim d As Date
d = DateSerial(CInt(Left$(dPart, 4)), CInt(Mid$(dPart, 5, 2)), CInt(Right$(dPart, 2)))
If d = targetDate Then
If IsNumeric(seqPart) Then
Dim n As Long
n = CLng(seqPart)
If n > maxSeq Then maxSeq = n
End If
End If
End If
End If
End If
Next
GetNextDateSeq = maxSeq + 1
End Function
ここでの重要ポイントをしっかり押さえます。
番号の形式を「yyyymmdd-xxx」と決め打ちして、その前提で文字列を分解しています。
左8文字を日付部分、10文字目以降を連番部分として扱っています。
targetDate と同じ日付の番号だけを見て、その中の最大値を探しています。
この関数は「番号列を全部なめる」ので、行数が多いと重くなります。
実務では、対象期間を絞ったり、別シートに「日付ごとの最終番号」をキャッシュしたりする工夫もありえますが、
まずは「仕組みを理解する」ことを優先して、シンプルな形にしています。
日付＋連番の番号文字列を作る関数
Public Function FormatDateSeq(ByVal targetDate As Date, ByVal seq As Long, _
Optional ByVal digits As Long = 3) As String
Dim dPart As String
dPart = Format(targetDate, "yyyymmdd")
Dim fmt As String
fmt = String(digits, "0")
FormatDateSeq = dPart & "-" & Format(seq, fmt)
End Function
例えば、
FormatDateSeq(DateSerial(2025,1,1), 1) → “20250101-001”
となります。
実際に日付＋連番を振る Sub
Public Sub AssignNextNo_DateSeq()
Dim ws As Worksheet
Set ws = Worksheets("Requests")
Dim nextRow As Long
nextRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
Dim today As Date
today = Date
Dim seq As Long
seq = GetNextDateSeq(ws, 1, today)
Dim noStr As String
noStr = FormatDateSeq(today, seq, 3)
ws.Cells(nextRow, "A").Value = noStr
ws.Cells(nextRow, "B").Value = today
ws.Activate
ws.Cells(nextRow, "C").Select
End Sub
これで、
同じ日に何件登録しても、
20250101-001, 20250101-002, 20250101-003, …
と連番が振られ、翌日になると
20250102-001 から始まります。
応用：キーごとに連番を振る（部署別・顧客別など）
「部署コード＋連番」の採番イメージ
次は、こういう番号を考えます。
HR-001, HR-002, …
IT-001, IT-002, …
つまり、「部署ごとに連番を持ちたい」ケースです。
考え方は日付＋連番と同じで、
部署コードをキーにして、その部署の番号の最大値を探す
最大値＋1 を「その部署の次の番号」とする
です。
キー（部署コード）ごとの次番号を返す関数
' ModSeq_Key.bas
Option Explicit
Public Function GetNextKeySeq(ByVal ws As Worksheet, _
ByVal colNo As Long, _
ByVal key As String) As Long
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, colNo).End(xlUp).Row
Dim maxSeq As Long
maxSeq = 0
Dim r As Long
For r = 2 To lastRow
Dim v As Variant
v = ws.Cells(r, colNo).Value
If Not IsEmpty(v) Then
Dim s As String
s = CStr(v)
Dim pos As Long
pos = InStr(s, "-")
If pos > 0 Then
Dim keyPart As String
keyPart = Left$(s, pos - 1)
Dim seqPart As String
seqPart = Mid$(s, pos + 1)
If StrComp(keyPart, key, vbTextCompare) = 0 Then
If IsNumeric(seqPart) Then
Dim n As Long
n = CLng(seqPart)
If n > maxSeq Then maxSeq = n
End If
End If
End If
End If
Next
GetNextKeySeq = maxSeq + 1
End Function
番号形式は「KEY-xxx」と決め打ちしています。
KEY 部分が部署コード（HR, IT など）、xxx が連番です。
キー＋連番の番号文字列を作る関数
Public Function FormatKeySeq(ByVal key As String, ByVal seq As Long, _
Optional ByVal digits As Long = 3) As String
Dim fmt As String
fmt = String(digits, "0")
FormatKeySeq = key & "-" & Format(seq, fmt)
End Function
実際に部署別番号を振る Sub
Public Sub AssignNextNo_ByDept()
Dim ws As Worksheet
Set ws = Worksheets("Requests")
Dim nextRow As Long
nextRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
Dim dept As String
dept = InputBox("部署コードを入力してください（例：HR, IT）", "部署コード")
If dept = "" Then Exit Sub
Dim seq As Long
seq = GetNextKeySeq(ws, 1, dept)
Dim noStr As String
noStr = FormatKeySeq(dept, seq, 3)
ws.Cells(nextRow, "A").Value = noStr
ws.Cells(nextRow, "B").Value = Date
ws.Cells(nextRow, "C").Value = dept
ws.Activate
ws.Cells(nextRow, "D").Select
End Sub
ここでは部署コードを InputBox で聞いていますが、
実務では「部署コードを別セルに入力しておき、そこから読む」方がミスが減ります。
重要ポイントの深掘り：採番で絶対に外したくないところ
「見た目の番号」と「内部の数値」を分けて考える
採番でよくある混乱が、「番号を数値として扱うか、文字列として扱うか」です。
000001 を数値として扱うと、Excel は 1 と認識します。
見た目のゼロは書式で付けているだけなので、文字列として比較するときにズレが出ます。
実務では、次のように割り切るのがおすすめです。
番号列は「文字列」として扱う（セルの表示も文字列）。
内部で「次の番号」を計算するときだけ、数値に変換して +1 する。
つまり、
セルに入っているのは “REQ-000123” という文字列
GetNextSeq などの関数は、必要な部分だけ数値に変換して計算する
という構造です。
これを徹底しておくと、「0001 と 1 が同じかどうか」で悩まなくて済みます。
「最終行を見る」だけだと、途中の欠番は埋まらない
今回のテンプレは、「最終行の番号＋1」を基本にしています。
これは「欠番を気にしない」前提です。
もし「途中で削除された番号を再利用したい」という要件があると、
ロジックは一気に複雑になります。
実務では、ほとんどの場合「欠番は気にしない」方が安全です。
削除された番号を再利用すると、「昔の資料に出てくる番号」と「今の番号」がぶつかる可能性があるからです。
監査やトレーサビリティの観点からも、「一度使った番号は二度と使わない」が基本です。
同時に複数人が使うときの“競合”問題
Excel ファイルを共有して、複数人が同時に採番する場合、
理屈の上では「同じ番号が二重に発行される」可能性があります。
Aさんが最終行を見て「REQ-0005」と判断
Bさんも同じタイミングで「REQ-0005」と判断
Aさんが書き込む
Bさんも書き込む
というパターンです。
Excel 単体でこれを完全に防ぐのは難しいです。
本気でやるなら、番号だけは DB や Web API で一元管理する、という世界になります。
ただ、現場レベルでは、
採番は基本的に1人が担当する
共有ブックではなく、個人作業後にマージする
番号の重複チェックを別途走らせる（重複があれば警告）
などの運用でカバーすることが多いです。
番号ルールは「先に紙で決めてから」VBA に落とす
採番ツールを作るときに一番やりがちなのが、
VBAを書きながら番号ルールを考え始める
ことです。
そうではなく、
番号のフォーマット（例：REQ-yyyymmdd-xxx）
どこでリセットするか（日ごと／月ごと／部署ごと）
欠番は許容するか
人が手で書き換えるのを許すか
を、先に紙やメモで決めてから、それを忠実にVBAに落とす、という順番が大事です。
まとめ：採番も「型」を作れば、どのシートにもコピペで組み込める
採番自動ツールの本質は、
次の番号（数値）をどう決めるか
その番号をどういう文字列（フォーマット）にするか
を分けて考え、それぞれを関数としてテンプレ化することです。
GetNextSeq / GetNextDateSeq / GetNextKeySeq で「次の数値」を決める。
FormatSeq / FormatDateSeq / FormatKeySeq で「見た目の番号」を作る。
シート側の Sub では、「どの行に、どの形式で番号を入れるか」だけを書く。
この構造さえ一度作ってしまえば、
案件管理表
申請一覧
問い合わせ管理
社内チケット管理
どんなシートにも、ほぼコピペで「採番機能」を組み込めるようになります。