[[20190218152340]]　『２つのシートを比較して、不要な行を削除したい』（じす）　ページの最後に飛ぶ

『２つのシートを比較して、不要な行を削除したい』（じす）

ＶＢＡで２つのシートを比較して、不要な行を削除したいです。

シート１とシート２があるとき、

＜シート１（異動前）＞
　　Ａ列　　　Ｂ列　Ｃ列
１　社員番号　氏名　人事
２　01　　　　山田　人事
３　02　　　　佐藤　人事
４　03　　　　鈴木　経理
５　04　　　　山下　総務
６　05　　　　斉藤　総務

＜シート２（異動後）＞
　　Ａ列　　　Ｂ列　Ｃ列
１　社員番号　氏名　部署
２　01　　　　山田　経理
３　03　　　　鈴木　人事
４　05　　　　斉藤　人事

２つのシートを比較して、下記のように、
シート２に名前がない社員の行をシート１から削除したいです。

＜シート１（異動前）＞
　　Ａ列　　　Ｂ列　Ｃ列
１　社員番号　氏名　部署
２　01　　　　山田　人事
３　03　　　　鈴木　経理
４　05　　　　斉藤　総務

今まで、Vookupを使い、手動で削除していたのですが、
急遽、あまりにも多くのブックで同じ作業をする必要が生じてしまい、
VBAを利用したいと考えています。（Excel2010使用）

お手数ですが、ご教示の程、よろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：unknown ＞

Sub main()

    Dim c  As Range
    For Each c In Intersect(Sheets("異動前").UsedRange, Sheets("異動前").Range("B2:B" & Rows.Count))
        If Sheets("異動後").Range("B2:B" & Rows.Count).Find(c.Value, , , xlWhole) Is Nothing Then
            Application.DisplayAlerts = False
            c.EntireRow.Delete
        End If
    Next c
End Sub
（mm） 2019/02/18(月) 15:49

 Option Explicit
Sub main()
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim i As Long
    Dim j As Long
    Dim buf
    Dim df As Boolean
    Set s1 = Worksheets("移動前")
    Set s2 = Worksheets("移動後")
    buf = s2.Range("A1").CurrentRegion
    For j = s1.Cells(s1.Rows.Count, 1).End(xlUp).Row To 2 Step -1
        For i = 2 To UBound(buf, 1)
            If buf(i, 1) = s1.Cells(j, 1) Then
                df = True
                Exit For
            End If
        Next
        If Not df Then s1.Cells(j, 1).EntireRow.Delete
        df = False
    Next
End Sub
（隠居じーさん） 2019/02/18(月) 16:14

この度は、早々にご回答くださり、ありがとうございます。

□mm様
一部、削除されない社員データがありました。
今は急ぎ処理が必要なため、時間が空きましたらご教示いただいたコードを
あらためて確認したいと思います。ありがとうござました。

□隠居じーさん様
ご教示いただいたコードで、今、処理を進めています。
本当に困っていたので、大変感謝しております。ありがとうございます。

度々の質問で大変恐縮なのですが、
＜シート１（異動前）＞

 　　Ａ列　　　Ｂ列　　　Ｃ列　Ｄ列
 １　発令日　　社員番号　氏名　部署
 ２　day　　   number    name  dep
 ３　4/1       01　　　　山田　人事 
 ４　4/1       02　　　　佐藤　人事 
 ５　4/1       03　　　　鈴木　経理 
 ６　4/1       04　　　　山下　総務 
 ７　4/1       05　　　　斉藤　総務

＜シート２（異動後）＞

 　　Ａ列　　　Ｂ列　　　Ｃ列　Ｄ列
 １　発令日　　社員番号　氏名　部署
 ２　day　　   number    name  dep
 ３　4/1       01　　　　山田　経理 
 ４　4/1       03　　　　鈴木　人事 
 ５　4/1       05　　　　斉藤　人事

上記のように、１行目と２行目が見出しで、
Ａ列に共通の内容が入っている場合、先ほどのコードを
どのように変更すればよいか、ご教示いただけますでしょうか。

この形式のブックがあと数十近くあり、試しに色々入れてみたものの
どうもうまく出来ず、頭を抱えています。
もしよろしければ、教えていただけたら幸いです。
何卒、よろしくお願いいたします。

（じす） 2019/02/18(月) 17:16

 Option Explicit
Sub main()
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim i As Long
    Dim j As Long
    Dim buf
    Dim df As Boolean
    Set s1 = Worksheets("移動前")
    Set s2 = Worksheets("移動後")
    buf = s2.Range("A1").CurrentRegion
    For j = s1.Cells(s1.Rows.Count, 2).End(xlUp).Row To 3 Step -1
        For i = 3 To UBound(buf, 1)
            If buf(i, 2) = s1.Cells(j, 2) Then
                df = True
                Exit For
            End If
        Next
        If Not df Then s1.Cells(j, 1).EntireRow.Delete
        df = False
    Next
End Sub

 でしょうか。
（隠居じーさん） 2019/02/18(月) 17:29

気になった点。。。
社員番号が01,02,03.。。となっていますが
文字列でしょうか
それとも、表示形式が０１で中身は数値でしょうか
双方の表の形態が同じなら問題は無いとは思うのですが。
確認はしていません。結果はチェックしてくださいね。
余計な事でしたらすみません。
でわ

（隠居じーさん） 2019/02/18(月) 17:43

隠居じーさん様

ご回答くださり、ありがとうございます。

社員番号は数値で、双方の表の形態は同じでしたので
ご教示いただいたVBAは正しく作動しました！
昨晩からずっとひたすら実行～その後の作業を繰り返して、
やっと終わりのメドが見えてきたところです。
ほとほと途方にくれて泣きかけていたので、感謝してもしきれません。

本当にありがとうございました。

（じす） 2019/02/19(火) 10:43

書きためている間に話がおわっちゃってましたが、参考になるかもしれないので投稿しておきます。

たぶん、名前はともかくとして、社員番号はユニーク（重複がない）なのだとおもいます。
そうなると、「シート１（異動前）」のA列のうち、「シート２（異動後）」のA列に無い社員番号のセルは、行ごと削除って考え方でよいですね。

そして、上記に併せて「あまりにも多くのブックで同じ作業をする必要が生じてしまい」ですから、複数のブックをいっぺんに処理することも考えた方がよいですね。

このようにいくつかの要素がまざった処理は、部品ごとに考えるとよいかもです。
前段の該当行を探して削除する処理はこんな感じじゃないでしょうか

 (1)ブックを開く
 (2)開いたブックの「シート１（異動前）」のA列２行目から～最終行までのうち
    「シート２（異動後）」のA列に社員番号がなければ、削除対象としてセルを覚えておく
 (3)覚えておいたセルがあれば、まとめて行ごと削除する
 (4)ブックを保存して閉じる。

この処理で肝になるのは、どうやって「シート２（異動後）」のA列に社員番号がないかを探す部分です。
すでに、Findメソッド（一般操作の【検索】と同じ）での案が示されていますので、私からは別案でワークシート関数のMATCH関数をつかった例を提示します。

    Sub 部品1()
        Const ふぁいるぱす As String = "D:\Temp\test01.xlsx"
        Dim i As Long
        Dim MyRNG As Range, 削除対象 As Range

        Stop '←ブレークポイントのかわり

        With Workbooks.Open(ふぁいるぱす)
            With .Worksheets("＜シート１（異動前）＞ ")

                '▼データがあるか判定
                If .Cells(.Rows.Count, "A").End(xlUp).Row > 1 Then

                    '▼A2～A列最終行まで処理
                    For Each MyRNG In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
                        If IsError(Application.Match(MyRNG.Value, .Parent.Worksheets("＜シート２（異動後）＞").Range("A:A"), 0)) Then

                            '▼MATCH関数の返り値がエラー値だったら、そのセルを追加で覚える
                            If 削除対象 Is Nothing Then
                                Set 削除対象 = MyRNG
                            Else
                                Set 削除対象 = Union(削除対象, MyRNG)
                            End If
                        End If
                    Next MyRNG

                    '▼覚えたセルがあったら処理
                    If Not 削除対象 Is Nothing Then
                        削除対象.EntireRow.Delete
                    End If

                End If
            End With

            '▼別名にして保存
            .SaveAs .Path & "\【済】" & .Name

            '▼ブックを閉じる
            .Close
        End With
    End Sub

（もこな２） 2019/02/19(火) 20:24

もこな２様

投稿くださり、ありがとうございます。

なんとか処理を終えて、今後のために勉強しようとスレッドを開いたところ、
もこな２様からのていねいな解説入りの返信を見つけ、嬉しい気持ちでいっぱいになりました。
お礼が遅れてしまい、大変失礼いたしました。

これから、じっくりともこな２様の投稿を読んで勉強します！
ありがとうございました。

（じす） 2019/02/22(金) 16:21

コメント返信：

[ 一覧(最新更新順) ]

[[20190218152340]] 『２つのシートを比較して、不要な行を削除したい』（じす） ページの最後に飛ぶ

[[20190218152340]]　『２つのシートを比較して、不要な行を削除したい』（じす）　ページの最後に飛ぶ