セルに抜けた番号の代わりに空白を挿入する

A列のセルに番号が入力されています。
セルの先頭行にある番号は必ず「1」です、最終行の番号は決まっていません。
先頭行と最終行の間にはその範囲内の番号が昇順で入力されています。
重複はありません。空白もありません。行の数は毎回違います。
先頭行が「1」です、例えば最終行が「6」、その間のセルに「2」、「3」と入力してある時
（A1が「1」、A2が「2」、A3が「3」、A4が「6」）
抜けている番号に空白を挿入したいです。

マクロを実行すると
A1が「1」、A2が「2」、A3が「3」、A4が「空白」、A５が「空白」、A6が「6」
としたいです。

お詳しい方宜しくお願いいたします。

質問者からの補足コメント

• すごいです、ちなみにA列にあわせて隣のB列にも空白を挿入することもできないでしょうか？
  申し訳ありません、宜しくお願いいたします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/04/11 19:31

No.4 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/04/12 08:38

以下のようにしてください。

Option Explicit

Sub 空白行挿入()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim maxrow As Long
Dim wrow As Long
Dim pval As Long
Dim val As Long
Dim i As Long
maxrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
pval = ws.Cells(maxrow, "A").Value
For wrow = maxrow - 1 To 1 Step -1
val = ws.Cells(wrow, "A").Value
If (pval - val) > 1 Then
For i = 2 To pval - val
ws.Rows(wrow + 1).Insert
Next
End If
pval = val
Next
MsgBox ("完了")
End Sub

No.3 回答者： fujillin 回答日時： 2023/04/10 22:11

No2です。

同じ内容の連投になってしまいました。
申し訳ありません。

No.2 回答者： fujillin 回答日時： 2023/04/10 22:09

こんばんは

A列だけを処理すればよいってことでしょうか。

詳細に不明がありますが、大雑把にはこんな感じでしょうか？

Sub hoge()
Dim r As Range, v
Dim m As Long, i As Long
Set r = Columns(1).Find(1, LookIn:=xlValues, LookAt:=xlWhole)
m = Int(Application.Max(Columns(1)))
If m < 2 Then Exit Sub
ReDim v(1 To m, 1 To 1)
For i = 1 To m
If Not Columns(1).Find(i, LookAt:=xlWhole) Is Nothing Then v(i, 1) = i
Next i
If Not r Is Nothing Then r.Resize(m).Value = v
End Sub

No.1 回答者： fujillin 回答日時： 2023/04/10 22:06

こんばんは

A列だけで良いのでしょうかね。

細かいところが不明ですが、大雑把にこんな感じでしょうか？

Sub hoge()
Dim r As Range, v
Dim m As Long, i As Long
Set r = Columns(1).Find(1, LookIn:=xlValues, LookAt:=xlWhole)
m = Int(Application.Max(Columns(1)))
If m < 2 Then Exit Sub
ReDim v(1 To m, 1 To 1)
For i = 1 To m
If Not Columns(1).Find(i, LookAt:=xlWhole) Is Nothing Then v(i, 1) = i
Next i
If Not r Is Nothing Then r.Resize(m).Value = v
End Sub