Excelの新旧シート比較で階層を合わせたい

Question

前提・実現したいこと

Excel　VBA　でシート1(旧)とシート２(新)の番号を比較して、
一致するのであればスルー、
一致しないのであればシート１(旧)に空白の行を挿入する。
という操作を行い、シート2(新)で追加されて行とシート１(旧)
の階層を合わせたいです。

初めてVBAを触り、独学でいろいろ試しているのですがなかなかできません。
以下のようなコードを組んで繰り返しで指定の行まで処理をすればいいかと思っているのですが
行き詰っています。

Public Sub 比較()

Dim S1, S2 As String

If Sheet2(年度計画)(4, 1) = Sheet3(月計画)(4, 1) Then
Sheet2(年度計画)(4, 1) = Sheet3(月計画)(4, 1)
Else
Sheet2(年度計画)(4, 1).Insert Shift:=xlShiftDown
End If

End Sub

初歩的な内容だと思いますが、どなたかご教授お願いいたします。

Comments

[sazi]

Sheet2のコピーを行い、そのシートにSheet1の内容を転記して、それをsheet1に置き換える方が、挿入などが不要になり、コードはシンプルになりそうですが。

[amasan]

年度始めのデータと月々のデータの比較をしてコスト評価等をしたい為、階層を合わせれば後は関数で評価が出来るので、挿入などで階層は合わしたいと考えています。

[plomte]

階層を合わせなくても、VLOOKUPやMATCHなどの関数を使っても、同様のことができるように思います。

Answer 1

ご質問の内容から、前提条件をいくつか推測します。
・旧シートのシート名が「年度計画」
・新シートのシート名が「月計画」
・比較する「番号」というのは、A列にある
・比較する行は、4行目から始まる
・旧シートも新シートも番号に歯抜けはない（A列の途中に空白はない）
・旧シートの番号は新シートにすべてある（番号は追加はあるが削除はない）

Sub Main()

Dim i As Long

With ThisWorkbook
For i = 4 To .Sheets("月計画").UsedRange.Rows.Count
    DoEvents
    If .Sheets("年度計画").Range("A" & i).Value = "" Then
'        Exit For
    ElseIf .Sheets("年度計画").Range("A" & i).Value <> .Sheets("月計画").Range("A" & i).Value Then
        .Sheets("年度計画").Rows(i).Insert Shift:=xlShiftDown
    End If
Next i
End With

End Sub

処理内容：
①月計画の最終行まで、年度計画の番号と月計画の番号が違う場合は、年度計画に行を挿入する。
②年度計画の番号が最後を超えたら（A列が空白だったら）、そこで終わりにする。

Comments

[amasan]

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

教えていただいたコードを試しに入力して実行したのですが、実行時エラー1004が出てしまいます。
比較しようとしている番号が、AB123456789-10のような形なのですが・・・

ネットで調べているのですがなかなか解決が出来ず・・・

[plomte]

大変失礼いたしました。回答欄のコードを修正しました。今度はいかがでしょうか。

[amasan]

ありがとうございます。
最初の４０行ほどは問題なく行けたのですが、月計画の終わりまで全部空白になってしまいます。
VLOOKUPなどの関数でも番号単体であれば行けるとは思うのですが、その何列か隣の列の予算を比較したいため階層を合わせたいと思っています。

[plomte]

一部修正しましたが、これでも同じでしょうか。

[plomte]

もしかすると、年度計画にあったものが月計画では無くなったり、年度計画の番号の順番から月計画では番号の順番の上下が入れ替わったり、そういうケースがあるのでしょうか？

[plomte]

VLOOKUPの場合ですが、A列に番号、E列に予算が入っているとします。その場合に
=VLOOKUP($A4,年度計画!$A$4:$E$50,5,FALSE)
=VLOOKUP($A4,月計画!$A$4:$E$50,5,FALSE)
というふうに、別々のシートから番号（第一引数）をキーにして予算（第三引数）を取ってきて、
それを比較すればよいと思うのですが、いかがでしょうか。

Answer 2

こんな感じでどうでしょうか。

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Sheets("年度計画")
    Set ws2 = Sheets("月計画")
    
    Dim i, r, m
    r = 4
    For i = 4 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        m = WorksheetFunction.Match(ws1.Cells(r, 1), ws2.Columns(1), False)
        If m = r Then
            r = r + 1
        Else
            ws1.Rows(r).Resize(m - r).Insert
            r = m + 1
        End If
    Next