【VBA】Excelのリストに[No.]を自動で振る

2021年12月21日2022年4月30日

リストを作成する際に、
左側に「No.」をふることは多いと思います。
今回はこの「No.」を、

VBAコードを使って表の埋まっているところまで、自動で記入する

サンプルコードを記載します。

今回はNo.を振る事だけをVBAで自動化していますが、
通常はNo.を振る元々のリストの作成もVBAコードを用いて
作成するならば、またコードの書き方も変わってきます。

※今回記載するコードも使えなくはありませんが、あくまで【No.を振るだけのVBAコード】です。もしも【リスト作成のVBA】があるのであれば、うまく２つのコードを結合させて【リスト作成のVBA】＋【No.を振るVBA】を１つにしましょう。

1. 例題とコード
- 1.1. リストに見出しがある場合
- 1.2. リストに見出しが無い場合

例題とコード

VBA_Numbering_1 — 【左図】＝見出しがあるリスト
【右図】＝見出しがないリスト

例えば上の画面のようなリストを作成したとします。
ここから左側A列に「No.」を自動で振るには
以下のサンプルコードを使ってみてください。
　

リストに見出しがある場合

Sub Numbering_Test()

 Dim i, cnt1, Endline1, Endline2 As Long
 
 If ActiveSheet.Range("B2") <> "" Then
  Endline1 = ActiveSheet.Range("B1").End(xlDown).Row
  If ActiveSheet.Range("A2") <> "" Then
   Endline2 = ActiveSheet.Range("A1").End(xlDown).Row
   cnt1 = Endline2
  ElseIf ActiveSheet.Range("A2") = "" Then
   Endline2 = 1
   cnt1 = 1
  End If
  
  If Endline1 > Endline2 Then
   For i = Endline2 + 1 To Endline1
    ActiveSheet.Cells(i, 1) = cnt1
    cnt1 = cnt1 + 1
   Next i
  End If
 
 End If

End Sub

リストの先頭に見出しを設ける場合は
（例題で言えば）素直に【A1】からEnd.Downで最終行を確定して
『For + Next』のループ機能を使って「1-2-3-4-5…」といった具合に
リストの端まで数字をふっていきます。
　

上のコードを使用すれば、

「No.１から」という先頭から数字を振る場合でも
「No.３から」という中途半端な数字からNo.を振る場合でも
「No.１だけ」数字を振る場合でも

全て対応しています。
その為、コードは少々複雑ですが…

リストに見出しが無い場合

Sub Numbering4()

 Dim i, cnt1, Endline1, Endline2 As Long
 
 If ActiveSheet.Range("B1") <> "" And ActiveSheet.Range("B2") <> "" Then
  Endline1 = ActiveSheet.Range("B1").End(xlDown).Row
  If ActiveSheet.Range("A1") <> "" And ActiveSheet.Range("A2") <> "" Then
   Endline2 = ActiveSheet.Range("A1").End(xlDown).Row
   cnt1 = Endline2 + 1
  ElseIf ActiveSheet.Range("A1") <> "" And ActiveSheet.Range("A2") = "" Then
   Endline2 = 1
   cnt1 = Endline2 + 1
  ElseIf ActiveSheet.Range("A1") = "" Then
   Endline2 = 0
   cnt1 = 1
  End If
  
  If Endline1 > Endline2 Then
   For i = Endline2 + 1 To Endline1
    ActiveSheet.Cells(i, 1) = cnt1
    cnt1 = cnt1 + 1
   Next i
  End If
  
 ElseIf ActiveSheet.Range("B1") <> "" And ActiveSheet.Range("B2") = "" Then
  Endline1 = 1
  ActiveSheet.Cells(1, 1) = 1
  
 End If
End Sub

リストの先頭１行目に、いわゆる『見出し』が無い場合は、
これまたコードがさらに複雑になります。
見出しが無いリストも「無くはない」という気持ちで作成しました。
　