VBA删除没有列值的重复行

Question

我有一张电子表格，可作为跟踪出院情况的日志。这是每天更新的，我得到重复数据（如果患者仍然在医院但尚未出院）。欺骗行已被删除，但错误的欺骗行为将被删除。

列H-J显示是否安排了后续操作，我不希望删除此项，只删除H-J列中没有值的重复项。我正在努力将这个条件添加到我的代码中。非常感谢帮助。

这是我的代码和下面电子表格的图片：

Sub DeDupe()
  Columns("A:J").Select
  ActiveSheet.Range("$A$1:$J$1225").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 6, 7), Header:=xlYes
  Range("C8").Select
End Sub

Answer 1

这适用于Windows。如果您使用MAC，则将ArrayList替换为Collection或购买Windows PC。

Sub RemoveDuplicatedWithEmtpyCells()
    Application.ScreenUpdating = False
    Dim x As Long
    Dim key As String
    Dim list As Object
    Set list = CreateObject("System.Collections.ArrayList")
    With Worksheets("Sheet1")
        For x = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1
            key = Join(Array(.Cells(x, 1), .Cells(x, 2), .Cells(x, 3), .Cells(x, 4), .Cells(x, 6), .Cells(x, 7)), "|")
            If list.Contains(key) Then
                If Len(Join(Array(.Cells(x, 8), .Cells(x, 9), .Cells(x, 10)), "")) = 0 Then .Rows(x).Delete
            Else
                list.Add key
            End If
        Next
    End With
    Application.ScreenUpdating = False
End Sub

Answer 2

快速又脏，但适用于您提供的测试用例：排序，然后删除重复项。

Sub DeDupe()
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets("Sheet1")    ' Always a good idea
    ws.Range("$A$1:$J$1225").Sort Header:=xlYes, key1:=ws.Range("A1:A1225"), order1:=xlAscending, key2:=ws.Range("H1:H1225"), order2:=xlDescending
    ws.Range("$A$1:$J$1225").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 6, 7), Header:=xlYes   ' ^ column with blanks ^^             ^^^^^^^^^^^^ blanks last
End Sub

对H列进行降序排序会使空白最后，至少在Windows 8.1上测试时是否存在空白。然后RemoveDuplicates保留第一行并删除其他行，从而删除带有空格的行。

您可能需要添加其他排序条件。如果是这样，首先找出一种有效的排序。然后打开宏录制器，进行排序，关闭宏录制器，然后粘贴录制的排序代码，代替上面的Sort行。