Вам не нужен VBA.Это можно сделать с помощью Advanced Filter
, используя критерии формулы.
Таблице данных требуется строка заголовка
Критерии формулы:
A2: =SUMPRODUCT(--(A10=Sheet1!$B$10:$B$14))=0
A3: =A10=B10
До
![enter image description here](https://i.stack.imgur.com/vslnE.png)
Диалог
![enter image description here](https://i.stack.imgur.com/4x0R8.png)
После
![enter image description here](https://i.stack.imgur.com/cH1fS.png)
Если вы не хотите выполнять фильтрацию на месте, есть опция для вывода вотдельный диапазон в диалоге.
Если бы я собирался использовать решение VBA, я бы, вероятно, использовал бы словарь для сбора интересующих строк, а затем плюнул бы их на диапазон результатов / лист
Это один из способов сделать это.
За счет более сложного кодирования этот алгоритм можно значительно ускорить, используя в коде массивы VBA.Но я выбрал более простой путь для демонстрации.Я бы использовал более сложный метод, только если этот метод окажется слишком медленным.
Этот алгоритм предполагает, что исходная таблица начинается в A9, но вы можете легко это изменить.
Он также сохраняет первоеэто не соответствует критериям исключения, тогда как метод расширенного фильтра сохраняет последнюю строку.Любой из них можно изменить, чтобы он работал противоположным образом.
Option Explicit
Sub filterMatchesAB()
Dim rSrc As Range, C As Range, rRes As Range
Dim wsSrc As Worksheet, wsRes As Worksheet
Dim myDict As Object, myKey As Variant
Dim I As Long
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
Set rRes = wsRes.Cells(1, 1)
With wsSrc
Set rSrc = .Range(.Cells(9, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=5)
End With
Set myDict = CreateObject("Scripting.Dictionary")
For Each C In rSrc.Rows
myKey = C.Cells(1, 1)
If Not myDict.exists(C.Cells(1, 2).Value) Then
myDict.Add Key:=myKey, Item:=C
End If
Next C
Application.ScreenUpdating = False
I = 0
For Each myKey In myDict.keys
I = I + 1
myDict(myKey).Copy rRes(I, 1)
Next myKey
End Sub