キーの重複があった場合にレコードの削除をしたい

Question

実現したいこと

VBAを仕事で使用することになり学習をしています。学習中の初心者です。

上記画像のCSVファイルがありますが、IDが重複しているレコードがあった場合（画像でいうa1、a3、a4）点検に〇がついているレコードを残し、実施に〇がついているレコードを削除したいです。

以下画像のようにしたいです。

レコード数は画像では9件になっていますが、実際には万単位の件数となる予定です。また、列数も増減します。

考えていること

レコード数が多い場合は、配列をした方が高速化するということも聞いたのですが、今回のように重複をチェックする際には逆に処理に時間がかかってしまうのではないかと考えました。
なので、ネットで調べ
以下の関数を使用してプログラムを組むと便利なのではないかと考えました。

RemoveDuplicates Columns:=Array(1), Header:=xlYes

しかし、うまく実現できません。

該当のソースコード

Sub duplicateDelete()
    
    Dim rowsData As Integer
    Dim columnsData As Integer
    Dim MasterWs As Worksheet
    Dim Region As Variant

    Set MasterWs = Worksheets("test")

    rowsData = MasterWs.Cells(Rows.Count, 1).End(xlUp).Row

    Region = MasterWs.Range("A2" & rowsData).CurrentRegion.Select
    Region.RemoveDuplicates Columns:=Array(1), Header:=xlYes


End Sub

試したこと

上記のコードを使用するとエラーが発生します。
.CurrentRegion.Selectでレコードを選択をし、変数に代入しました。
その上で.RemoveDuplicates Columns:=Array(1), Header:=xlYesを使用
するとエラーが発生します。
.CurrentRegion.Selectを変数にいれず、

MasterWs.Range("A2" & rowsData).CurrentRegion.Select.RemoveDuplicates Columns:=Array(1), Header:=xlYes

と書いてもエラーが出てしまいます。
ただもしこの関数が使用できたとしても、点検実施の条件式を使うことも
難しそうなので、この関数を使用すること自体が適切ではないのではないかと思い始めました。

もしご助言やオススメの書き方などがあれば、ご教授頂けると幸いです。

Answer 1

点検と実施が1:1のデータが前提のコードになります。

Sub test()

    Dim jisshi As Object
    Dim tenken As Object
    Dim delete As Collection
    Dim sht As Worksheet
    Dim i As Double
    
    Set jisshi = CreateObject("Scripting.Dictionary")
    Set tenken = CreateObject("Scripting.Dictionary")
    Set sht = ActiveWorkbook.Worksheets(1)
    
    With sht
        For i = .Cells(1, 1).End(xlDown).Row To 2 Step -1
            If .Cells(i, 3).Value = "〇" Then
                jisshi.Add .Cells(i, 1).Value, .Cells(i, 1).Row
                If tenken.exists(.Cells(i, 1).Value) Then
                    .Rows(i).delete
                End If
            ElseIf .Cells(i, 4).Value = "〇" Then
                tenken.Add .Cells(i, 1).Value, .Cells(i, 1).Row
                If jisshi.exists(.Cells(i, 1).Value) Then
                    .Rows(jisshi.Item(.Cells(i, 1).Value)).delete
                End If
            End If
        Next i
    End With

End Sub

Comments

[taku-s]

連想配列を２つ使用し、確認し合っていくんですね！
普段別のプログラミング言語を使用していますが、この方法は自分の引き出しにはなかったです。

処理も無事実現できました、ありがとうございます！

Answer 2

データ件数が多い重複チェックは連想配列(Dictionary)を使うと高速処理できます。

Sub duplicateDelete()
    Application.ScreenUpdating = False
    
    Dim rng As Range
    Set rng = Cells(1).CurrentRegion
    Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1, 4) '表のデータ範囲(D列まで)
    Dim ary()
    ary = rng.Value 'データ範囲を配列に
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    'C列が〇のIDをDictionaryに登録
    Dim i As Long
    For i = 1 To UBound(ary)
        If ary(i, 4) = "〇" Then dic(ary(i, 1)) = i
    Next
    
    'D列が〇でかつIDがDictionaryに存在するときA列を"×"に
    For i = 1 To UBound(ary)
        If ary(i, 3) = "〇" Then
          If dic.Exists(ary(i, 1)) Then ary(i, 1) = "×"
        End If
    Next
    rng.Value = ary '配列をデータ範囲に代入
    
    Cells(1).AutoFilter Field:=1, Criteria1:="×" 'A列が×の行を抽出
    Cells(1).CurrentRegion.Offset(1).EntireRow.Delete '行削除
    Cells(1).AutoFilter
    
    Application.ScreenUpdating = True
End Sub

Comments

[taku-s]

Application.ScreenUpdating = True　を調べてみたのですが、処理を高速化する記述の一つなんですね。細やかに対応していただきありがとうございます。

上記のプログラムを動かしてみたのですが、aryとrngでエラーが発生してしまいました。
aryは二次元配列として宣言し直しエラー解消の対応ができたのですが、「rng」がエラー解消ができません。ここで使用されている「rng」は何を宣言しているのでしょうか。

[hatena19]

コードを修正したときに、コピーミスしていたようです。
回答のコードを修正しましたので、確認ください。
サンプルで動作確認済みです。

行削除も１行ずつするのではなく、削除行にしるしをつけて、それでフィルターをかけて一気に削除することで高速化してます。

[taku-s]

ご返答ありがとうございます。
私の環境でも、動作ができました。

フィルターで削除するなど、SQLのようなこともできるんですね。
全くの別件ですが今後仕事をする上で、VBAでもSQLでいうINNER JOINみたいなことができないか検討しておりました。
そういう意味でも今後に繋がるヒントのようなものも感じました。
ありがとうございます！