VBA删除没有列值的重复行

我有一个电子表格，充当跟踪医院出院的日志。这是每天更新，我得到重复的数据（如果病人仍然在医院，尚未出院）。这些模糊的行被删除，但错误的重复被删除。VBA删除没有列值的重复行

列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

enter image description here

来源

2016-12-02 kfire35

它看起来像[RemoveDuplicates]（https://msdn.microsoft.com/en-us/library/office/ff193823.aspx）没有提供任何更好的控制行被删除。 – cxw

同意@cxw，我担心你需要用一个完整的宏来编写自己的“推理器”，这个宏会检查重复项（在字典中）以及列I-J是否为空。 –

如果我无法进一步修改RemoveDuplicates，会不会有更好的方法来解决这个问题？我正在考虑循环遍历所有行并删除具有AG行中相同数据的dupe，但我不确定如何将HJ中的数据保留到相应的行，而不是在删除dupe行时向下移动，if这就说得通了。 – kfire35

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

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上的Excel 2013中处于测试状态。然后RemoveDuplicates保留第一行并删除其他行，从而删除带有空白的行。

您可能需要添加其他排序条件。如果是这样，首先找出一种有效的排序。然后打开宏录像机，执行此操作，关闭宏录像机，然后粘贴录制的分类代码，以代替上述的Sort行。

来源

2016-12-02 17:18:34 cxw

完美地工作。谢谢@ cxw！ – kfire35

@ kfire35很高兴帮助！正如我认为你刚刚发现的那样，你只能接受一个答案。但是，您可以同时使用这两种产品，因为这两者都可以帮助您，所以这样做是有道理的。查看[tour]（https://stackoverflow.com/tour）了解更多关于物流的信息（以及另一个徽章:)）。 – cxw

这将在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

来源

2016-12-02 17:02:14

This Works too，thanks @Thomas Inzina！ – kfire35

VBA删除没有列值的重复行

回答

相关问题