Question

我是VBA的新手，所以这可能是一个非常明显的错误。

为了简短起见，我试图根据两个条件删除行：在A列中，如果它们具有相同的值（重复），而在B列中，则差异是小于 100 ，然后从底部删除一行。

示例数据：

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

这是我想出的代码：

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

这在很大程度上有效，但前提是第二个条件是大于（>）而不是小于（<）。小于时，它会删除每一行。我究竟做错了什么？有简单的解决方法吗？

谢谢

Answer 1

不是

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

在语句的第二部分，您只是将.Cells(j, "B").Value与const 100进行比较！

但是

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

Abs（）可能会有所帮助，否则只需保留（）

Answer 2

类似的事情应该对您有用：

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

选择代码格式，您也可以使用一个For循环来完成此操作。

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

自从j = i开始，每个第一个j周期都通过将一行与自身进行比较而开始。值与其自身之间的差始终为零。（它还将第二行与自身进行比较，这是最后一步。）

但是，如果您切换：

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

收件人：

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

代码将比较所有各行，而不进行自我比较。

另一点（@Proger_Cbsk的answer引起了我的注意）是，仅用减法.Cells(i, "B").Value - .Cells(j, "B").Value < 100进行比较有时会导致意外的结果。

例如，假设.Cells(i, "B").Value = 1和.Cells(j, "B").Value = 250。我们可以看出，两者至少相差100，因此您希望表达式的这一部分的值为False。但是，通过直接替换，您将得到表达式：1 - 250 < 100。从1 - 250 = -249开始，从-249 < 100开始，该表达式实际上将求值为True。

但是，如果将.Cells(i, "B").Value - .Cells(j, "B").Value < 100更改为Abs(.Cells(i, "B").Value - .Cells(j, "B").Value) < 100，则表达式现在将查看差异是大于还是小于100，而不是查看如果相减结果大于或小于100。

Answer 5

为什么不使用内置命令：

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

Range.RemoveDuplicates Method (Excel)

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

5 个答案: