メインコンテンツへスキップ

Excelで連続番号が欠落している場合に番号または行を挿入するにはどうすればよいですか?

ワークシートに連番のリストがあるが、シーケンス内にいくつかの欠落している番号があり、シーケンスが完全であることを確認するために、欠落している番号または空白行を挿入する必要があるとします(次のスクリーンショットを参照)。 Excelでこの問題をすばやく解決するにはどうすればよいですか?

Doc-Insert-Missing-Number1 -2 Doc-Insert-Missing-Number2

重複の並べ替えと削除機能を使用して、シーケンスに欠落している番号を挿入します

VBAコードを使用してシーケンスに欠落している番号を挿入します

VBAコードで欠落しているシーケンスの空白行を挿入します

Kutools for Excelを使用して、シーケンスに欠落している番号または空白行を挿入します


矢印青い右バブル 重複の並べ替えと削除機能を使用して、シーケンスに欠落している番号を挿入します

欠落している番号をXNUMXつずつ見つけて挿入できる場合もありますが、連続する番号が数百ある場合、欠落している番号の場所を特定するのは困難です。 Excelでは、重複の並べ替えと削除機能を使用してこのタスクを処理できます。

1。 シーケンスリストの最後に続いて、2005023001から2005023011までの別のシーケンス番号を入力します。スクリーンショットを参照してください。

Doc-Insert-Missing-Number3

2。 次に、XNUMXつのシーケンス番号の範囲を選択し、 且つ > ZをZにソートする、スクリーンショットを参照してください:

Doc-Insert-Missing-Number4

3。 また、選択したデータは次のスクリーンショットのように並べ替えられています。

Doc-Insert-Missing-Number5

4。 次に、クリックして重複を削除する必要があります 且つ > 重複を削除する、そして飛び出した 重複を削除する ダイアログボックスで コラム 重複を削除する名前。スクリーンショットを参照してください。

Doc-Insert-Missing-Number6 -2 Doc-Insert-Missing-Number7

5。 次に、をクリックします OK、の重複 列A が削除され、シーケンスリストに欠落している番号が挿入されました。スクリーンショットを参照してください。

Doc-Insert-Missing-Number8


矢印青い右バブル VBAコードを使用してシーケンスに欠落している番号を挿入します

上記の方法で非常に多くの手順があると思われる場合は、この問題を解決するのに役立つVBAコードもここにあります。 次のようにしてください。

1。 を押し続けます Alt + F11 キー、そしてそれは開きます アプリケーション向け Microsoft Visual Basic 窓。

2に設定します。 OK をクリックします。 インセット > モジュール、次のコードをに貼り付けます モジュール 窓。

VBA:シーケンスに欠落している番号を挿入します

Sub InsertValueBetween()
'Updateby Extendoffice
Dim WorkRng As Range
Dim Rng As Range
Dim outArr As Variant
Dim dic As Variant
Set dic = CreateObject("Scripting.Dictionary")
'On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
num1 = WorkRng.Range("A1").Value
num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Value
interval = num2 - num1
ReDim outArr(1 To interval + 1, 1 To 2)
For Each Rng In WorkRng
    dic(Rng.Value) = Rng.Offset(0, 1).Value
Next
For i = 0 To interval
    outArr(i + 1, 1) = i + num1
    If dic.Exists(i + num1) Then
        outArr(i + 1, 2) = dic(i + num1)
    Else
        outArr(i + 1, 2) = ""
    End If
Next
With WorkRng.Range("A1").Resize(UBound(outArr, 1), UBound(outArr, 2))
    .Value = outArr
    .Select
End With
End Sub

3。 次に、 F5 このコードを実行するためのキーを押すと、プロンプトボックスが表示されます。不足している数字を挿入するデータ範囲を選択してください(タイトル範囲は選択しないでください)。スクリーンショットを参照してください。

Doc-Insert-Missing-Number9

4。 そして、 OK、欠落している番号がシーケンスリストに挿入されました。 スクリーンショットを参照してください:

Doc-Insert-Missing-Number1 -2 Doc-Insert-Missing-Number2

矢印青い右バブル VBAコードで欠落しているシーケンスの空白行を挿入します

場合によっては、不足している番号の場所を特定し、データの間に空白行を挿入するだけで、必要に応じて情報を入力できるようになります。 もちろん、次のVBAコードもこの問題の解決に役立ちます。

1. 押したまま Alt + F11 キー、そしてそれは開きます アプリケーション向け Microsoft Visual Basic 窓。

2に設定します。 OK をクリックします。 インセット > モジュール、次のコードをに貼り付けます モジュール 窓。

VBA:欠落しているシーケンスの空白行を挿入します

Sub InsertNullBetween()
'Updateby Extendoffice
Dim WorkRng As Range
Dim Rng As Range
Dim outArr As Variant
Dim dic As Variant
Set dic = CreateObject("Scripting.Dictionary")
'On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
num1 = WorkRng.Range("A1").Value
num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Value
interval = num2 - num1
ReDim outArr(1 To interval + 1, 1 To 2)
For Each Rng In WorkRng
    dic(Rng.Value) = Rng.Offset(0, 1).Value
Next
For i = 0 To interval
    If dic.Exists(i + num1) Then
        outArr(i + 1, 1) = i + num1
        outArr(i + 1, 2) = dic(i + num1)
    Else
        outArr(i + 1, 1) = ""
        outArr(i + 1, 2) = ""
    End If
Next
With WorkRng.Range("A1").Resize(UBound(outArr, 1), UBound(outArr, 2))
    .Value = outArr
    .Select
End With
End Sub

3。 次に、 F5 キーを押してこのコードを実行すると、プロンプトボックスが表示され、欠落しているシーケンスに空白行を挿入するデータ範囲を選択します(タイトル範囲は選択しないでください)。スクリーンショットを参照してください。

Doc-Insert-Missing-Number9

4。 そして、 OK、欠落しているシーケンスリストに空白行が挿入されています。 スクリーンショットを参照してください:

Doc-Insert-Missing-Number1 -2 Doc-Insert-Missing-Number10

矢印青い右バブル Kutools for Excelを使用して、シーケンスに欠落している番号または空白行を挿入します

ここでは、簡単で便利なツールを紹介します- Kutools for Excelそのと 欠落しているシーケンス番号を見つける この機能を使用すると、欠落しているシーケンス番号または空白行を既存のデータシーケンスの間にすばやく挿入できます。

Kutools for Excel : 300以上の便利なExcelアドインがあり、30日以内に制限なしで無料で試すことができます

あなたがインストールしている場合 Kutools for Excel、次のようにしてください。

1。 不足している番号を挿入するデータシーケンスを選択します。

2に設定します。 OK をクリックします。 クツール > インセット > 欠落しているシーケンス番号を見つける、スクリーンショットを参照してください:

3。 の中に 欠落しているシーケンス番号を見つける ダイアログボックス、チェック 欠落しているシーケンス番号を挿入しています 不足している番号を挿入するか、欠落しているシーケンス番号に遭遇したときに空白行を挿入する 必要に応じて空白行を挿入します。 スクリーンショットを参照してください:

Doc-Insert-Missing-Number10

4。 そして、 OK ボタンをクリックし、欠落しているシーケンス番号または空白行がデータに挿入されています。スクリーンショットを参照してください。

Doc-Insert-Missing-Number10 2 Doc-Insert-Missing-Number10 2 Doc-Insert-Missing-Number10

今すぐExcel用のKutoolsをダウンロードして無料トライアル!


矢印青い右バブル  デモ:Kutools for Excelを使用して、シーケンスに欠落している番号または空白行を挿入します

Kutools for Excel:300以上の便利なExcelアドインがあり、30日以内に制限なしで無料で試すことができます。 今すぐダウンロードして無料トライアル!

関連記事:

Excelで欠落している番号のシーケンスを識別する方法は?

最高のオフィス生産性向上ツール

🤖 Kutools AI アシスタント: 以下に基づいてデータ分析に革命をもたらします。 インテリジェントな実行   |  コードを生成  |  カスタム数式の作成  |  データを分析してグラフを生成する  |  Kutools関数を呼び出す...
人気の機能: 重複を検索、強調表示、または識別する   |  空白行を削除する   |  データを失わずに列またはセルを結合する   |   数式なしのラウンド ...
スーパールックアップ: 複数の基準の VLookup    複数の値の VLookup  |   複数のシートにわたる VLookup   |   ファジールックアップ ....
詳細ドロップダウン リスト: ドロップダウンリストを素早く作成する   |  依存関係のドロップダウン リスト   |  複数選択のドロップダウンリスト ....
列マネージャー: 特定の数の列を追加する  |  列の移動  |  Toggle 非表示列の表示ステータス  |  範囲と列の比較 ...
注目の機能: グリッドフォーカス   |  デザインビュー   |   ビッグフォーミュラバー    ワークブックとシートマネージャー   |  リソースライブラリ (自動テキスト)   |  日付ピッカー   |  ワークシートを組み合わせる   |  セルの暗号化/復号化    リストごとにメールを送信する   |  スーパーフィルター   |   特殊フィルター (太字/斜体/取り消し線をフィルター...) ...
上位 15 のツールセット12 テキスト ツール (テキストを追加, 文字を削除する、...)   |   50+ チャート 種類 (ガントチャート、...)   |   40+ 実用的 (誕生日に基づいて年齢を計算する、...)   |   19 挿入 ツール (QRコードを挿入, パスから画像を挿入、...)   |   12 変換 ツール (数字から言葉へ, 通貨の換算、...)   |   7 マージ&スプリット ツール (高度な結合行, 分割セル、...)   |   ... もっと

Kutools for Excel で Excel スキルを強化し、これまでにない効率を体験してください。 Kutools for Excelは、生産性を向上させ、時間を節約するための300以上の高度な機能を提供します。  最も必要な機能を入手するにはここをクリックしてください...

説明


Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作​​業をはるかに簡単にします

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
Comments (12)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
I have used the code for "VBA: insert blank rows for missing sequence" as listed above and works great - but i need it to insert rows across the all columns it only adds rows to the first 2 columns of my selection - not my entire table.
This comment was minimized by the moderator on the site
Hello, Melanie,

To solve your problem, maybe the following code can help you: (Note: A indicates the column contains the missing sequence, please change it to your need.)
Sub InsertBlankRowsForMissingSequence()
    Dim i As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If IsNumeric(Cells(i, "A").Value) And IsNumeric(Cells(i - 1, "A").Value) And Cells(i, "A").Value <> "" And Cells(i - 1, "A").Value <> "" Then
            If Cells(i, "A").Value - Cells(i - 1, "A").Value > 1 Then
                Debug.Print Cells(i, "A").Value - Cells(i - 1, "A").Value - 1
                Rows(i).Resize(Cells(i, "A").Value - Cells(i - 1, "A").Value - 1).Insert
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Please have a try, hope it can help you!
This comment was minimized by the moderator on the site
I am trying to use the VBA for sequential numbers. I have several columns next to the numbers of which numbers too. I.e.
1. HL Meter 34
2. HL Watermeter 40
4. HL CO2meter 24

When I use the code it works for the first 3 columns but it gets mixed up if I include the 4th column since it includes numbers too.
How can I change the code to make sure the numbers in column 4 stay the same?
This comment was minimized by the moderator on the site
Thank you amazing
This comment was minimized by the moderator on the site
What if i want to select 6 columns and then check 1st column for dates and if dates are missing add a row(blank cells) for all 6 columns
This comment was minimized by the moderator on the site
I want to use "Inserting missing sequence Number" feature but it's not supporting for digits more than 12 ? there are many sets in which I want to insert the sequence between (it's a alpha-numeric digit) can you help
This comment was minimized by the moderator on the site
Hi, I want to use "Inserting Missing Sequence Number", but it's not supporting if the no. of digits are more than 12 can you help ?
This comment was minimized by the moderator on the site
What if i want to select 6 columns and then check 1st column for dates and if dates are missing add a row(blank cells) for all 6 columns
This comment was minimized by the moderator on the site
Thank you very much. How do i change the script if the increments is only 0.02 and not 1 This is for the script InsertNullBetween()
This comment was minimized by the moderator on the site
this worked and was very easy to complete the task. Thank you.
This comment was minimized by the moderator on the site
Thanks ! Great script ! How i can modify this script if i say we need to process not only ID column + NAME column, but ID column + NAME column + NEW column ? How i can add new columns in this script?
This comment was minimized by the moderator on the site
The following is the modified macro to include an added column - Another important point is that when prompted to select the range, you should only select the first column - these took me a few hours! hope to save others' time

Sub InsertValueBetween()
'Updateby Extendoffice
Dim WorkRng As Range
Dim Rng As Range
Dim outArr As Variant
Dim dic As Variant
Set dic = CreateObject("Scripting.Dictionary")
Dim dic2 As Variant
Set dic2 = CreateObject("Scripting.Dictionary")

'On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
num1 = WorkRng.Range("A1").Value
num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Value
interval = num2 - num1
ReDim outArr(1 To interval + 1, 1 To 3)
For Each Rng In WorkRng
dic(Rng.Value) = Rng.Offset(0, 1).Value
dic2(Rng.Value) = Rng.Offset(0, 2).Value
Next
For i = 0 To interval
outArr(i + 1, 1) = i + num1
If dic.Exists(i + num1) Then
outArr(i + 1, 2) = dic(i + num1)
outArr(i + 1, 3) = dic2(i + num1)
Else
outArr(i + 1, 2) = ""
outArr(i + 1, 3) = ""

End If
Next
With WorkRng.Range("A1").Resize(UBound(outArr, 1), UBound(outArr, 2))
.Value = outArr
.Select
End With
End Sub
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations