Excel VBA Автофильтр

Question

Мои данные, как следует:

Имя Значение флага

Alice 5 Выкупу

Боб 8 Перейти

Dan 9

Alice 1

Alice 6 Jump

Dan 0 Выкуп

Боб 8 Перейти

Если для любого имени, в какой-либо записи, в поле флага, если есть «Выкуп», то я хочу, чтобы сохранить все записи, связанные с этим именем. У Алисы 3 записи, и один из них - BUYBACK, поэтому я хочу сохранить все записи ALice. У Дэна есть выкуп в одном из двух, поэтому я хочу сохранить обе записи Дэна, пока обе записи Боба будут удалены.

Когда я пытаюсь сделать это ниже, я получаю сообщение об ошибке в моем автофильтре. Ошибка говорит «Требуется объект». Я не могу понять, что случилось.

n = 1 

    Dim BBK_Array() As Variant 

    For j = 1 To FinalRow 

     If Cells(j, 3).Value = "BUYBACK" Then 
      If n = 1 Then 
       ReDim Preserve BBK_Array(1 To n) 
       BBK_Array(n) = Cells(j, 1).Value 
       n = n + 1 

      ElseIf BBK_Array(n - 1) <> Cells(j, 1).Value Then 
        ReDim Preserve BBK_Array(1 To n) 
        BBK_Array(n) = Cells(j, 1).Value 
        n = n + 1 

      End If 


     End If 
    Next j 




    ActiveWorksheet.UsedRange.AutoFilter Field:=1, Criteria1:=BBK_Array(), Operator:=xlFilterValues 

EDIT:

Когда я сделал это, он работал. Я не знаю почему:

 ActiveWorkbook.Activesheet.UsedRange.AutoFilter Field:=1, Criteria1:=BBK_Array(), Operator:=xlFilterValues 

Answer 1

Вам нужен VBA для этого? Простая формула Excel может решить вашу проблему.

Допустим, что ваши данные выглядит следующим образом

Все, что вам нужно сделать, это создать 4-й столбец и ввести в формулу в ячейке D2

=SUMPRODUCT((A:A=A2)*(C:C="BuyBack"))

Просто автоматического заполнения формулу к последней строке. Теперь фильтруйте col D на 0 и удалите его.

Смотрите это.

После этого, удалите седловины D

Если вы все еще хотите решение VBA затем записать макрос и выполните описанные выше шаги и просто изменить его в соответствии с вашими потребностями. Это будет 9 строк кода (в том числе деклараций)

Ниже приведен пример

Sub Sample() 
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 
    Dim lRow As Long: lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row 

    ws.Range("D2:D" & lRow).Formula = "=SUMPRODUCT((A:A=A2)*(C:C=""BuyBack""))" 
    ws.Range("D2:D" & lRow).Value = ws.Range("D2:D" & lRow).Value 

    ws.AutoFilterMode = False 
    ws.Range("D2:D" & lRow).AutoFilter Field:=1, Criteria1:="=0" 
    ws.Range("D2:D" & lRow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    ws.AutoFilterMode = False 

    ws.Columns(4).Delete 
End Sub 

И это на выходе мы получаем после того, как макрос запускается.