ExcelVBAについて急ぎです。どなたか教えてください。

###前提・実現したいこと
ExcelVBAについてです。ある列に、昇順に文字列が並んでいます。昇順ではありますが、条件分岐させる際、同じとみなされる文字列（01××、01○○、01△△等）が続けて並んでいます。条件に見合うものがあればその行のいくつかのセルを抜き出します。一つ条件に見合う文字列が見つかれば、以降はその条件に見合う文字列が見つかっても、スルーします。また、昇順に文字列が並んでいても、抜け落ちている部分（01××、02××、03××ではなく、01××、03××のように）があります。その場合抜け落ちている部分を直前に抜き出した文字列の後に、続けて連番にしていきます。続け方は抜け落ちている部分（先程の例でいえば、02××）と直前に抜き出したものと同じものです。図で示すと以下のようになります。

実行前のシート実行後の(別)シート
A B C A B C
1 01×× 1234 1236 1 01 1234 1236
2 01○○ 2513 3652 2 02 1234 1236
3 03■■ 8564 9641 ⇒ 3 03 8564 9641
4 05□□ 2289 3654 4 04 8564 9641
5 05○□ 3568 4875 5 05 2289 3654
・・・・・・・・
スルーする部分まで以下のようにコードを書きましたが、欠番の部分をどう書いたらいいかわからず進んでおりません。まだ、実行まで進んでおりません。
どうかよろしくお願いいたします。

###該当のソースコード
Dim i As Long
Dim j=2 As Long
For i=2 To .Cells(Rows.Count,1).End(xlUp).Row
If .Cells(i,1) == .Cells(i+1,1) Then
.Sheet(別シート).Cells(j,2)= Left(.Cells(i,1),2)
.Sheet(別シート).Cells(j,2)= .Cells(i,2)
.Sheet(別シート).Cells(j,2)= .Cells(i,3)
End If
i = i+1
Do While (.Cells(i,1) == .Cells(i+1,1))
i = i+1
Loop
Next

###補足情報(言語/FW/ツール等のバージョンなど)
Excel2010 、win7

行動規範の内容に同意します

回答2件

今回の処理を行う場合、以下が前提になると思いますが認識あってますでしょうか？
・実行前シートのA列先頭２桁をキーとして判定をする
・欠番が判定できることから、キー2桁は最低が「00」、最大が「99」である

あと欠番の自動作成の部分について、
・実行後シートには実行前シートの先頭キー番号～最終キー番号（例では「01」～「05」の５行）のデータが作成される。
⇒前行のデータから自動作成するのは番号が飛んだ時だけで、最終データ以降の欠番は作成しない
という認識ですがあってますでしょうか？

以上を前提として改修方針を説明します。

全体の流れは

①キー退避変数の作成・初期化を行う
②実行前シートのデータ行をループ処理

 (行ループここから)
 
 ③処理行のA列セルからキー値（先頭２桁）を取得
 
 ④キー値の判定
  ④-a キー値が退避変数と同じ場合
    ⇒ ④-a-1 次の行へスキップ

  ④-b キー値が退避変数＋１の場合
    ⇒ ④-b-1 今回行の内容を実行後シートに出力
      ④-b-1 退避変数に今回のキー値をセット

  ④-c キー値が退避変数＋１でない場合
    ⇒ ④-c-1 退避変数+1からキー値-1まで欠番を補うループ処理
      （欠番ループここから）
          ④-c-2 前行の内容で実行後シートに出力
      （欠番ループここまで）
      ④-c-3 今回行の内容を実行後シートに出力
      ④-c-4 退避変数に今回のキー値をセット
  
 (行ループここまで)
⑤処理終了

条件分岐があって少しわかりずらいですが、こんな流れになると思います。

これをコードに落とすと以下のようになります。

Sub test()
    Dim iKey As Integer     '今回のキー値
    Dim iKey_Bk As Integer  '前回のキー値
    iKey_Bk = -1    '初期化
    
    Dim iRowR As Long '読込行
    Dim iRowW As Long '出力行
    Dim iLoop As Long '欠番ループカウンタ
    iRowW = 2
    
    With Sheets("元シート")
        For iRowR = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            'キー値を取得
            iKey = CInt(Left(.Cells(iRowR, 1), 2))
            
            If iKey = iKey_Bk Then
                '前回と同じキーなら処理しない
            ElseIf iKey_Bk = -1 Or (iKey = iKey_Bk + 1) Then
                '初回、もしくは前回キー+1の場合はコピー処理
                Sheets("別シート").Cells(iRowW, 1) = Format(iKey, "00")
                Sheets("別シート").Cells(iRowW, 2) = .Cells(iRowR, 2)
                Sheets("別シート").Cells(iRowW, 3) = .Cells(iRowR, 3)
                '出力行を進める
                iRowW = iRowW + 1
                'キーを退避
                iKey_Bk = iKey
            Else
                '前回キー+1でない場合は欠番作成
                For iLoop = iKey_Bk + 1 To iKey - 1
                    '前行と同じ値でコピー処理
                    iKey_Bk = iKey_Bk + 1
                    Sheets("別シート").Cells(iRowW, 1) = Format(iKey_Bk, "00")
                    Sheets("別シート").Cells(iRowW, 2) = Sheets("別シート").Cells(iRowW - 1, 2)
                    Sheets("別シート").Cells(iRowW, 3) = Sheets("別シート").Cells(iRowW - 1, 3)
                    '出力行を進める
                    iRowW = iRowW + 1
                Next iLoop
                '今回キーのコピー処理
                Sheets("別シート").Cells(iRowW, 1) = Format(iKey, "00")
                Sheets("別シート").Cells(iRowW, 2) = .Cells(iRowR, 2)
                Sheets("別シート").Cells(iRowW, 3) = .Cells(iRowR, 3)
                '出力行を進める
                iRowW = iRowW + 1
                'キーを退避
                iKey_Bk = iKey
            End If
        Next
    End With
End Sub

今回は元シートの行数分ループして欠番を判定しましたが、
①先頭キー番号と最終キー番号をあらかじめ取得する
②先頭キー番号～最終キー番号までをループする
③処理中のキー番号（先頭行）を元シートから検索し、見つけた行からコピーする
という方法でも実現できると思います。

この場合、出力する行数分しかループしないのでループ回数は減りますが、検索する分処理が重くなりそうです(^-^;
ここで伝えたかったのは、実装方法は一つではないので用途に応じて使い分けましょう、ということです。

参考になれば幸いです。

投稿2017/02/08 11:46

jawa

総合スコア3013

整列済みの連続番号セルをもとにした定番のグループトータルアルゴリズムを使えばできます。
同一番号かを見張る変数gflagと欠番を埋めるためのhozoncell変数を用意し、番号がgflagと違ったときに新しい値をうつすか、欠番を埋めるかの処理を行います。そして、番号が一致しているときは、単純に次のセルにうつるように変数iに1を足します。
未検証ですが、以下のようなコードの形になると思います。

vba
1 Dim i As Long 
2 Dim j=2 As Long
3
4' 引き継ぎたいB列、C列のセルの値を保存する変数
5 Dim hozoncell2, hozoncell As Variant
6
7' グループがかわったを見張る見張りフラグ（欠番判断も兼ねる）
8 Dim gflag=0 As Long
9
10 i = 2
11 Do While i <= .Cells(Rows.Count,1).End(xlUp).Row  
12   If .Cells(i,1) > gflag Then
13' 単純に次の順番のデータの転送
14     If .Cells(i,1) == gflag + 1 Then
15       .Sheet(別シート).Cells(j,2)= Left(.Cells(i,1),2) 
16       .Sheet(別シート).Cells(j,2)= .Cells(i,2) 
17       .Sheet(別シート).Cells(j,3)= .Cells(i,3) 
18' 見張りフラグを書き換えて、旧データを保存しておく
19       gflag = .Cells(i,1)
20       hozoncell2 = .Cells(i,2)
21       hozoncell3 = .Cells(i,3)
22'   アクティブシートの行ポインタ i の移動
23       i = i+1 
24'   別シートの行ポインタ j の移動
25       j = j+1
26     Else
27' 欠番があったときに旧データを転送していく
28       Do While .Cells(i,1) < gflag + 1
29         gflag = gflag + 1
30         .Sheet(別シート).Cells(j,2)= gflag
31         .Sheet(別シート).Cells(j,2)= hozoncell2
32         .Sheet(別シート).Cells(j,3)= hozoncell3
33         j = j+1
34       Loop 
35     End If
36   Else
37' 同一番号の時は何もせずにアクティブシートのポインタを次の行にうつす。
38     i = i+1 
39   End If
40 Loop