列に入っている数値を項目ごとにカウントし、個数に応じて空白行を挿入したい

Question

前提・実現したいこと

VBAを使って、「A列に入っている数値を項目ごとにカウントし、その個数によって異なる数の空白行を挿入する」というシステムを作っています。
「異なる数の空白行」といいますのは、例えばA列に112222333と縦にデータが入っていたら、11(2×1=2行空白)2222(4×3=12行空白)333といった風に、同じ項目ごとに個数をカウントして(その分)×(その分-1)だけ空白行を挿入したいということです。

まったくのプログラミング初心者なのですが、自分なりにVBAを勉強した結果、「項目ごとに空白行を挿入する」という処理を行うためには、
For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
という文を使い、下からA列の値をカウントし、iステップ目ととi-1ステップ目でA列に入っている数値が異なる場合に
Rows(i).Insert
という処理を行うのが良いと行き着きました。

しかし、私が作りたいシステムでは、i-1ステップ目に入っている数値の個数をカウントし、その個数によって挿入する空白行を決めたいため、「iステップ目ととi-1ステップ目でA列に入っている数値が異なる場合に」というif文の中にもう一つif文を作り、i-1ステップ目に入っている数値と同じ数値が出てきた回数をカウントして空白行を決定するという処理を付け足しました。

発生している問題・エラーメッセージ

空白行を挿入するという処理自体は上手く出来たのですが、その行数が想定していた数と異なっていました。
例えば、A列に111222333444と同じ項目を3つずつ並べたデータに対して処理を行うと、
111(3×2=6行空白)222(5×4=20行空白)333(7×6=42行空白)444
となり、空白行を決定するカウントがリセット出来ていないようでした。

該当のソースコード

Sub macro1()
  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim cnt As Long
  Dim n As Long

  For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1

   If Range("A" & i).Value <> Range("A" & i - 1).Value Then
     For n = i - 1 To 3 Step -1

       'i行目に挿入する空白行の数を決定するために、i-1行目に入っている数値の出現数をカウント
       If Range("A" & n).Value = Range("A" & n - 1).Value Then cnt = cnt + 1
           j = cnt * (cnt - 1)
       Next n

          '決定した空白行(=j)の分だけ行の挿入を繰り返し
          For k = 1 To j Step 1
    Rows(i).Insert
        Next k
    cnt = 1

   End If
  Next i
    
End Sub

試したこと

カウントのリセットを上手く行えていないのではないかと考え、cnt = 1の処理を各行に入れてカウントのリセットを試しましたが、
If Range("A" & n).Value = Range("A" & n - 1).Value Then cnt = cnt + 1
j = cnt * (cnt - 1)
の間にcnt = 1を入れた時以外は同じ結果になりました。

補足情報（FW/ツールのバージョンなど）

Microsoft Office Professional Plus 2019
.xlsm(Excel マクロ有効ブック)
にてMicrosoft Visual Basic for Applications(マクロ)を作成しました。

初心者につきまして、分かりにくいプログラミング文や質問文になってしまいましたが、何卒よろしくお願いいたします。

Answer 1

質問者さんのコードを最小限の変更でするなら、下記ですね。

Sub macro1()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim cnt As Long
    Dim n As Long

    For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1

        If Range("A" & i).Value <> Range("A" & i - 1).Value Then
            cnt = 1
            For n = i - 1 To 3 Step -1

                'i行目に挿入する空白行の数を決定するために、i-1行目に入っている数値の出現数をカウント
                If Range("A" & i - 1).Value = Range("A" & n - 1).Value Then cnt = cnt + 1
            Next n
            j = cnt * (cnt - 1)

            '決定した空白行(=j)の分だけ行の挿入を繰り返し
            For k = 1 To j Step 1
                Rows(i).Insert
            Next k

        End If
    Next i

End Sub

---

自分なりに書くと下記になりました。

Sub macro1()
    Dim r As Long, cnt As Long
    r = 3: cnt = 1
    Do Until Cells(r + 1, 1) = ""
        If Cells(r, 1) = Cells(r + 1, 1) Then
            cnt = cnt + 1
            r = r + 1
        Else
            Rows(r + 1).Resize(cnt * (cnt - 1)).Insert
            r = r + cnt * (cnt - 1) + 1
            cnt = 1
        End If
    Loop
End Sub

Do...Loopで前から順にカウントしていく方が分かり安いしシンプルになると思います。
ttyp03さんのと考え方は同じですが、挿入はまとめてするようにしてみました。

Comments

[VBA_ganbaru]

ご回答いただきありがとうございます。

ご丁寧に、2パターンも修正を頂きましてありがとうございます。特に、hatena19様のオリジナルのプログラム文はとてもシンプルに私が作りたかったシステムの流れを表しておられ、システムの作り方そのものまで教えて頂いたような気持ちです。本当に参考にさせて頂きます。

私のプログラムを修正して頂いた方でご質問させて頂きたいのですが、15行目で
If Range("A" & i - 1).Value = Range("A" & n - 1).Value Then cnt = cnt + 1
とされておられると思いますが、こちらは
If Range("A" & n).Value = Range("A" & n - 1).Value Then cnt = cnt + 1
とならないのは何故でしょうか？ご修正まで頂いた上に申し訳ございませんが、もしお手隙でしたら教えて頂ければ幸いです。

[hatena19]

If Range("A" & n).Value = Range("A" & n - 1).Value Then cnt = cnt + 1
だとn行目とn-1行目が等しい件数を現在位置(i-1行目)から3行目までカウントしてしまうので、余計なものまでカウントしてしまいます。現在位置(i-1行目)と比較する必要があります。
本来なら、ここもFor...Nextで先頭まで戻るより、Do...Loopで値が変わるまてカウントするというようした方が無駄がないですね。

Answer 2

自分なりに書いてみましたが、結果的に似たようなコードになりました。
何が違うのか比較してみてください。
参考まで。

Sub macro1()
    Dim r As Long
    Dim i As Long
    Dim cnt As Long
    Dim add As Long
    r = 2
    cnt = 1
    Do While Cells(r, 1) <> ""
        If Cells(r, 1) <> Cells(r - 1, 1) Then
            add = cnt * (cnt - 1)
            For i = 1 To add
                Rows(r).Insert
            Next
            r = r + add + 1
            cnt = 1
        Else
            r = r + 1
            cnt = cnt + 1
        End If
    Loop
End Sub

Comments

[VBA_ganbaru]

ご回答いただき、ありがとうございます。

Rows(r).Insertの処理によって、次に処理するべきA列の数値がどんどん下に行ってしまうので、下から処理をするべき(Step -1)なのだと考えておりましたが、空白行を挿入した後にr = r + add + 1とすることで次に処理するポイントまで飛ぶ事ができるということですね。ttyp03様のプログラムは私が想定しておりました元々の操作とまったく同じ処理が出来るようにお書きになっておられるので、非常に直感的に分かりやすく助かりました。

大変勉強になりました。ご回答を頂き本当にありがとうございました。

[ttyp03]

行挿入のプログラムの場合、確かに下から処理しないとダメな場合もありますが、今回の場合はきちんと制御できいればどちらからでも可能な処理だと思います。
が、挿入位置まで戻ったり、挿入場所を記憶しておいたりと何かしら複雑な処理が発生すると思うので、面倒なことになりますね。