保持基于单元格的重复行

Posted 2023-03-29

【中文标题】保持基于单元格的重复行

【英文标题】：KEEP Duplicate rows based on cells

【发布时间】：2021-10-16 07:47:42

【问题描述】：

尝试搜索整个范围，并删除 B 列中没有重复的所有内容。

试试下面的代码

    lastrow = logSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    For r = 2 To lastrow
        If logSheet.Cells(r, 2).Value <> logSheet.Cells(r + 1, 2).Value Or logSheet.Cells(r, 2).Value <> logSheet.Cells(r - 1, 2).Value Then
            logSheet.Rows(r).EntireRow.Delete
        End If
    Next

以上只是保留其中一个重复，而不是两个。

我确定我错过了一些简单的东西，但我只是不停地放屁！

【问题讨论】：

删除一行后，后续行数会发生变化。因此，您必须从底部开始搜索，这样当您删除最后一行时，下面行号的更改不会影响宏的工作。

啊，当然！我完全略过它！编辑：刚刚将步骤 -1 放入其中，现在它会删除所有内容！

【参考方案1】：

您的代码似乎在检查下一行是否有重复项。这与您的描述不同，您对副本的位置只字未提。下面的代码将检测列中任何位置的重复项并删除没有的项。它应该适用于您的场景以及我设想的场景。

Sub DeleteSingles()
    ' 308

    Dim Rng     As Range
    Dim R       As Long
    
    Application.ScreenUpdating = False
    With LogSheet
        R = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Rng = .Range(.Cells(2, 1), .Cells(R, 1))
        For R = R To 2 Step -1
            If WorksheetFunction.CountIf(Rng, .Cells(R, 1).Value) = 1 Then
                .Rows(R).EntireRow.Delete
            End If
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

我检查重复项的方法似乎比你的简单。除此之外，由于删除，我的代码自下而上工作。