根据两列中的条件自动筛选Excel工作表

很抱歉，如果这是一个常见的问题，但我对Excel VBA的世界有点陌生，我一直很难找到一种方法来做我需要的事情

我有一个相当大的工作表，需要能够根据两列中的条件删除行

下面是一些非常基本的数据来解释我需要做什么

A列

苹果

香蕉

苹果

苹果

橙色的

葡萄

列B

蓝色的

红色的

绿色的

黄色的

黑色的

我需要删除a列中有重复值且B列中有空白值的行。因此，在上面的示例数据中，我想删除第4行，因为a列中有重复值（Apple），B列中有空白值

显然，在这个示例中，我可以轻松地手动删除该行。但是实际的工作表包含100000行，列A中的数据将是URL，而不是漂亮的简单水果

我已经研究过使用过滤，但无法找到一个好的（快速的）方法来达到我需要的效果。所以我认为它必须是Excel VBA，但我很高兴被证明是错的。如果VBA是一种可行的方法，那么有没有人有我可以使用/调整的例程？我发现有几个可以删除重复项，还有几个可以删除空白项。但我真的很难将它们结合起来，所以任何帮助都将不胜感激

---

谢谢。

我为您在OP中给出的示例编写了代码。您可以根据需要编辑代码。在尝试此操作之前，请备份原始文件，因为它会删除行

 Sub RemoveData()
    Dim LastRow, Filtred_Rows_Count As Long

    Sheets("Sheet1").Select
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set Rng = Range("A1:B" & LastRow)
    Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("J1"), Unique:=True

    For Each c In Range([J2], Cells(Rows.Count, "J").End(xlUp))
            With Rng
                .AutoFilter
                .AutoFilter Field:=1, Criteria1:=c.Value
                Filtred_Rows_Count = Intersect(Columns(1), ActiveSheet.UsedRange).SpecialCells(xlCellTypeVisible).Count
                If Filtred_Rows_Count > 2 Then
                    .AutoFilter Field:=2, Criteria1:=""
                    ActiveSheet.Range("A1:B" & LastRow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                End If
            End With
            ActiveSheet.ShowAllData
    Next
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
    Columns("J:J").EntireColumn.Delete
End Sub

---

我为您在OP中给出的示例编写了代码。您可以根据需要编辑代码。在尝试此操作之前，请备份原始文件，因为它会删除行

 Sub RemoveData()
    Dim LastRow, Filtred_Rows_Count As Long

    Sheets("Sheet1").Select
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set Rng = Range("A1:B" & LastRow)
    Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("J1"), Unique:=True

    For Each c In Range([J2], Cells(Rows.Count, "J").End(xlUp))
            With Rng
                .AutoFilter
                .AutoFilter Field:=1, Criteria1:=c.Value
                Filtred_Rows_Count = Intersect(Columns(1), ActiveSheet.UsedRange).SpecialCells(xlCellTypeVisible).Count
                If Filtred_Rows_Count > 2 Then
                    .AutoFilter Field:=2, Criteria1:=""
                    ActiveSheet.Range("A1:B" & LastRow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                End If
            End With
            ActiveSheet.ShowAllData
    Next
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
    Columns("J:J").EntireColumn.Delete
End Sub

---

请尝试以下代码：

Sub DeleteBlankDuplicate()
    Dim current As String
    ActiveSheet.Range("A1").Activate
    Do While ActiveCell.Value <> ""
        current = ActiveCell.Address
        ActiveCell.Offset(1, 0).Activate
        Do While ActiveCell.Value <> ""
            If ((ActiveSheet.Range(current).Value = ActiveCell.Value) And ActiveCell.Offset(0, 1).Value = "") Then
                ActiveSheet.Rows(ActiveCell.Row).Delete
            Else
            ActiveCell.Offset(1, 0).Activate
            End If
        Loop
        ActiveSheet.Range(current).Offset(1, 0).Activate
    Loop
End Sub

---

请尝试以下代码：

Sub DeleteBlankDuplicate()
    Dim current As String
    ActiveSheet.Range("A1").Activate
    Do While ActiveCell.Value <> ""
        current = ActiveCell.Address
        ActiveCell.Offset(1, 0).Activate
        Do While ActiveCell.Value <> ""
            If ((ActiveSheet.Range(current).Value = ActiveCell.Value) And ActiveCell.Offset(0, 1).Value = "") Then
                ActiveSheet.Rows(ActiveCell.Row).Delete
            Else
            ActiveCell.Offset(1, 0).Activate
            End If
        Loop
        ActiveSheet.Range(current).Offset(1, 0).Activate
    Loop
End Sub

---

谢谢Mrig&J.B。谢谢Mrig&J.B。