Excel VBAは1行ループでトリプル重複を削除します

Question

列G、H、Iのセルの3つの数値がすべて等しい場合に、行全体を削除します。私はvbaコードを書いて、何も削除しません。誰か助言できますか？

Sub remove_dup() 

Dim rng As Range 
Dim NumRows As Long 
Dim i As Long 


Set rng = Range("G2", Range("G2").End(xlDown)) 
NumRows = Range("G2", Range("G2").End(xlDown)).Rows.Count 

For i = 2 To NumRows 

Cells(i, 7).Select 
If Cells(i, 7).Value = Cells(i, 8).Value = Cells(i, 9).Value Then 
EntireRow.Delete 
Else 
Selection.Offset(1, 0).Select 
End If 

Next i 

End Sub 

Answer 1

このコードを試してください。行を削除するときは、常に最後の行から開始し、最初の行に向かって作業します。そうすれば、どんな行もスキップすることはありません。

Sub remove_dup() 
Dim rng As Range 
Dim NumRows As Long 
Dim i As Long 

NumRows = Range("G2", Range("G2").End(xlDown)).Rows.Count 
For i = NumRows + 1 To 2 Step -1 
     If Cells(i, 7).Value = Cells(i, 8).Value And Cells(i, 7).Value = Cells(i, 9).Value Then 
        Cells(i, 7).EntireRow.Delete 
     Else 
     End If 
Next i 
End Sub 

Answer 2

UNIONを使用してすべての行をまとめて削除できます。試してみてください

Sub remove_dup() 
    Dim ws As Worksheet 
    Dim lastRow As Long, i As Long 
    Dim cel As Range, rng As Range 

    Set ws = ThisWorkbook.Sheets("Sheet4") 'change Sheet3 to your data range 
    With ws 
     lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row 'last row with data in Column G 
     For i = lastRow To 2 Step -1 'loop from bottom to top 
      If .Range("G" & i).Value = .Range("H" & i).Value And .Range("G" & i).Value = .Range("I" & i).Value Then 
       If rng Is Nothing Then   'put cell in a range 
        Set rng = .Range("G" & i) 
       Else 
        Set rng = Union(rng, .Range("G" & i)) 
       End If 
      End If 
     Next i 
    End With 
    rng.EntireRow.Delete 'delete all rows together 
End Sub 

Answer 3

行を削除すると、逆順にループする必要があります。

...この試み与えてください

Sub remove_dup() 
Dim NumRows As Long 
Dim i As Long 

NumRows = Cells(Rows.Count, "G").End(xlUp).Row 

For i = NumRows To 2 Step -1 
    If Application.CountIf(Range(Cells(i, 7), Cells(i, 9)), Cells(i, 7)) = 3 Then 
     Rows(i).Delete 
    End If 
Next i 

End Sub