Блог

Все —

У меня есть Excel на 2 листа.

Лист 1 состоит из трех столбцов (имя, дата, значение), лист 2 — это имя.

Я хочу написать скрипт VBA, который отображает все данные листа 1, в которых НЕТ ни одного поля имени, указанного на листе 2, в любом месте листа 1 (имя может отображаться в разных столбцах, поэтому в идеале он будет искать все ячейки на листе 1), чтобы появиться на листе 3

Смотрите примерное изображение для получения приблизительного представления о том, чего я надеюсь достичь. Я искал, но не повезло.

Если у вас есть Excel 365, вы можете использовать формулы динамического массива

 =LET(Names,FILTER(Sheet1!$C:$E,Sheet1!$C:$C<>""),FILTER(Names,ISERROR(MATCH(INDEX(Names,,1),Sheet2!$G:$G,0))))
  

Пример:

Данные (Лист1)

Список исключений (Лист2)

Результат

_{Примечание: это исключает заголовки, поскольку метка заголовка Name присутствует как в столбце данных, так и в столбце исключения, поэтому обязательно сохраняйте это}

Без Excel 365. Я бы рекомендовал UDF

 Function FilterList(ByVal Data As Range, ByVal Exclusion As Range) As Variant
    Dim Res As Variant
    Dim Dat As Variant
    Dim Excl As Variant
    Dim rw As Long
    Dim idx As Long
    Dim cl As Long
    Dim ExcludeIt As Variant
    Dim Cols As Long
    Dim TopRow As Long
    
    ReDim Res(1 To Application.Caller.Rows.Count, 1 To Application.Caller.Columns.Count)
    
    If IsEmpty(Data.Cells(1, 1)) Then
        TopRow = Data.Cells(1, 1).End(xlDown).Row
        Set Data = Data.Resize(Data.Rows.Count - TopRow).Offset(TopRow - 1)
    End If
    
    If IsEmpty(Data.Cells(Data.Rows.Count, 1)) Then
        Set Data = Data.Resize(Data.Cells(Data.Rows.Count, 1).End(xlUp).Row - Data.Row   1)
    End If
    
    Dat = Data.Value
    Excl = Exclusion.Columns(1).Value
    
    Cols = Application.Min(UBound(Dat, 2), UBound(Res, 2))
    
    idx = 0
    For rw = 1 To UBound(Dat, 1)
        ExcludeIt = Application.Match(Dat(rw, 1), Excl, 0)
        If IsError(ExcludeIt) Then
            idx = idx   1
            For cl = 1 To Cols
                Res(idx, cl) = Dat(rw, cl)
            Next
        End If
    Next
    For rw = 1 To UBound(Res, 1)
        For cl = IIf(rw <= idx, UBound(Dat, 2)   1, 1) To UBound(Res, 2)
            Res(rw, cl) = vbNullString
        Next
    Next
    FilterList = Res
End Function
  

Введите его как формулу массива (заполните его с Ctrlпомощью ShiftEnter) в диапазоне, достаточно большом для хранения возвращаемых данных (может быть больше), и передайте ему диапазон входных данных и диапазон исключений (оба в виде целых столбцов)

 =FilterList(Sheet1!$C:$E,Sheet2!$G:$G)
  

Добро пожаловать в Stack Overflow!

Вы не сказали, где начинаются исходная таблица и таблица критериев, или куда поместить результат «антифильтра». Я написал этот код, исходя из предположения, что все они начинаются с первой ячейки рабочего листа, A1:

 Sub AntiFilter()
Dim aSource As Range, aCriteria As Range, oCell As Range, oTarget As Range, countCells As Long
    Set aSource = Worksheets("Sheet1").Range("A1").CurrentRegion
    countCells = aSource.Columns.Count
    Set aCriteria = Worksheets("Sheet2").Range("A1").CurrentRegion
    Set oTarget = Worksheets("Sheet3").Range("A1")
    aSource.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=aCriteria, Unique:=False
    For Each oCell In Application.Intersect(aSource, aSource.Columns(1))
        If oCell.RowHeight < 1 Then
            oCell.Resize(1, countCells).Copy Destination:=oTarget
            Set oTarget = oTarget.Offset(1, 0)
        End If
    Next oCell
    On Error Resume Next
    aSource.Worksheet.ShowAllData
    On Error GOTO 0
End Sub
  

Рабочая тетрадь с макросом, тестовыми данными и примерами критериев выбора на листе 2

Если макрос работает не так, как ожидалось, убедитесь, что в вашей книге есть листы с именами Sheet1, Sheet2 и Sheet3, а диапазон исходных данных и диапазон критериев начинаются с ячеек A1. Если это не так, внесите необходимые изменения в текст макроса: