Автоматическая фильтрация листа Excel на основе критериев в двух столбцах

Question

Извините, если это распространенный вопрос, но я немного новичок в мире Excel-VBA, и у меня возникли проблемы с поиском способа сделать именно то, что Мне нужно.

У меня довольно большой лист и вы должны иметь возможность удалять строки на основе критериев в двух столбцах.

Ниже некоторые основные данные, чтобы объяснить, что мне нужно сделать ...

Col A

1. Яблоко
2. Banana
3. компании Apple
4. компании Apple
5. Оранжевый
6. Grape

Col B

1. Синий
2. Красный
3. Зеленый
5. Желтый
6. Черный

Мне нужно удалить любые строки, где есть дублирующее значение в Col A и пустое значение рядом с ним в Col B. Итак, в приведенных выше примерах я хочу удалить Row 4, поскольку у него есть дублирующее значение (Apple) в Col A и пустое значение в Col B.

Очевидно, что в этом примере я мог бы легко удалить эту строку вручную. Но фактический лист содержит 10 000 строк, а данные в столбце A будут URL, а не приятными простыми фруктами!

Я посмотрел на использование фильтрации, но не могу разработать хороший (быстрый) метод достижения нужного результата. Поэтому я думаю, что это должен быть Excel VBA, но я более чем счастлив, что оказался ошибочным. Если VBA - это способ пойти, у кого-нибудь есть рутина, которую я мог бы использовать/адаптировать? Я нашел несколько, которые удалят дубликаты и некоторые, которые удалят пробелы. Но я действительно стараюсь их объединить, поэтому любая помощь будет очень признательна.

Спасибо.

Answer 1

Попробуйте следующий код:

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 

Вы не упомянули ли вы также хотите удалить строки, где оба Column A и Column B имеют одинаковые значения.Так что если вы хотите удалить строки с повторяющимися значениями в столбце А и столбец B или Столбец B является пустым затем заменить условие IF в коде выше, к следующему:

If ((ActiveSheet.Range(current).Value = ActiveCell.Value) And (ActiveSheet.Range(current).Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value) Or ActiveCell.Offset(0, 1).Value = "") Then 

Answer 2

Я написал код для примера, который вы указали в 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