Question

我想删除每列中重复行的所有，包括第一个重复的行，只留下根本没有任何重复的行，但重复的行必须包含两列匹配。有可能在表格中有数千行吗？

A           B
ID201       225 (leave this)
ID201       233 (leave this)
ID202       555 (delete this)
ID202       555 (delete this)
etc

Answer 1

使用宏，有一种缓慢的方法和快速的方法来做到这一点。如果您知道第一列中的每个项目都是“ID somenumber”形式，那么我们可以使用快速方法。如果不是，则必须使用慢速方法（按顺序检查每一行与每隔一行）。我已经包含了下面快速方法的代码

Sub RemoveDuplicates()

Dim IDVals As Object, RowsToDelete As String, ItemsToDelete As String
Set IDVals = CreateObject("Scripting.Dictionary")

Dim CheckCell As Range
For Each CheckCell In ActiveSheet.Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1))
    If Not IDVals.Exists(CheckCell.Value) And Not IsEmpty(CheckCell) Then
        IDVals.Add (CheckCell.Value), CheckCell.Address
    Else
        If ActiveSheet.Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)).Offset(0, 1).Value = CheckCell.Value Then
            RowsToDelete = RowsToDelete & CheckCell.Row & ","
            ItemsToDelete = ItemsToDelete & CheckCell.Value & ","
        End If
    End If
Next CheckCell

RowsToDelete = Left(RowsToDelete, Len(RowsToDelete) - 1) 'Removing last comma
Dim ParsedText() As String, Count As Integer, DeleteRange As Range
Elements = Len(RowsToDelete) - Len(Replace(RowsToDelete, ",", "")) 'Array of the length of elements
ReDim ParsedText(Elements)
ParsedText = Split(TextBox1.Value, ",")
DeleteRange = Range(Cells(Val(ParsedText(0)), 1).Address).EntireRow

For Count = 1 To Elements

    DeleteRange = Union(DeleteRange, Range(Cells(Val(ParsedText(Count)), 1).Address).EntireRow)

Next Count

DeleteRange.Delete

Dim IdValkey As String

'eliminating first instance of repeated value
For Each IdValkey In Split(Left(ItemsToDelete, Len(ItemsToDelete) - 1), ",")
    For Count = ActiveSheet.Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)) To 1
        If Cells(Count, 1).Value = IdValkey Then
            Range(Cells(Count, 1).Address).EntireRow.Delete
        End If
    Next Count
Next IdValkey
End Sub

删除重复的行，包括绑在多列中的第一行

1 个答案: