我究竟做错了什么？ 使用Excel VBA删除重复项

Question

I'm new to VBA so this is probably a very obvious mistake.

To keep it short, I am trying to delete rows based on two criteria: In Column A, if they have the same value (duplicate) and in Column B, the difference is less than 100, then one row is deleted from the bottom.

Example data:

Column A  Column B          
1         300              
1         350     SHOULD be deleted as second column diff. is <100 compared to row above
2         500              
2         700     Should NOT be deleted as second column diff. is not <100

Here is the code I have come up with:

Sub deduplication()

Dim i As Long
Dim j As Long
Dim lrow As Long

Application.ScreenUpdating = False

With Worksheets("Sheet1")

lrow = .Range("A" & .Rows.Count).End(xlUp).Row

    For i = lrow To 2 Step -1
        For j = i To 2 Step -1
            If .Cells(i, "A").Value = .Cells(j, "A").Value And .Cells(i, "B").Value - .Cells(j, "B").Value < 100 Then
               .Cells(i, "A").EntireRow.Delete
            End If
        Next j
    Next i

End With

End Sub

This largely works, but only if the second criterion is greater than (>) rather than less than (<). When it is less than, it deletes every row . What am I doing wrong? Is there an easy fix?

Thank you

Answer 1

Not

If .Cells(i, "A").Value = .Cells(j, "A").Value And .Cells(i, "B").Value - .Cells(j, "B").Value < 100 Then

Here in the second part of the statement, you're just comparing .Cells(j, "B").Value to const 100 !

But

If .Cells(i, "A").Value = .Cells(j, "A").Value And Abs(.Cells(i, "B").Value - .Cells(j, "B").Value) < 100 Then

Abs() may help, else keep just the ( )

Answer 2

Something like this should work for you:

Sub tgr()

    Dim ws As Worksheet
    Dim rDel As Range
    Dim rData As Range
    Dim ACell As Range
    Dim hUnq As Object

    Set ws = ActiveWorkbook.Sheets("Sheet1")
    Set hUnq = CreateObject("Scripting.Dictionary")


    Set rData = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
    If rData.Row = 1 Then Exit Sub  'No data

    For Each ACell In rData.Cells
        If Not hUnq.Exists(ACell.Value) Then
            'New Unique ACell value
            hUnq.Add ACell.Value, ACell.Value
        Else
            'Duplicate ACell value
            If Abs(ws.Cells(ACell.Row, "B").Value - ws.Cells(ACell.Row - 1, "B").Value) < 100 Then
                If rDel Is Nothing Then Set rDel = ACell Else Set rDel = Union(rDel, ACell)
            End If
        End If
    Next ACell

    If Not rDel Is Nothing Then rDel.EntireRow.Delete

End Sub

Answer 3

Sticking to the format of your code, you can do this using one For loop as well.

For i = lrow To 3 Step -1
    If .Cells(i, "A") = .Cells(i - 1, "A") And (.Cells(i, "B") - .Cells(i - 1, "B")) < 100 Then
        .Cells(i, "A").EntireRow.Delete
    End If
Next i

Answer 4

Every first j-cycle starts off by comparing a row to itself since you start with j = i . The difference between a value and itself is always zero. (It also compares row 2 with itself as the very last step.)

However, if you switch:

For i = lrow To 2 Step -1
For j = i To 2 Step -1

to:

For i = lrow To 3 Step -1
For j = i - 1 To 2 Step -1`

the code will compare all the various rows without the self-compares.

Another point (which @Proger_Cbsk 's answer brought to mind), is that doing the comparison with just the subtraction .Cells(i, "B").Value - .Cells(j, "B").Value < 100 will sometimes cause unexpected results.

For example, assume .Cells(i, "B").Value = 1 and .Cells(j, "B").Value = 250 . We can tell by just looking, that there is a difference of at least 100, so you would expect this part of the expression to evaluate to False. However, from straight substitution, you get the expression: 1 - 250 < 100 . Since 1 - 250 = -249 , and since -249 < 100 , the expression would actually evaluate to True.

However, if you were to change .Cells(i, "B").Value - .Cells(j, "B").Value < 100 to Abs(.Cells(i, "B").Value - .Cells(j, "B").Value) < 100 , the expression will now be looking at if the difference is greater or less than 100, instead of looking at if the subtraction result is greater or less than 100.

Answer 5

Why not to use the built-in command:

Worksheets("Sheet1").Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlYes

Range.RemoveDuplicates Method (Excel)