Я не уверен, правильно ли я понял, но вы хотите удалить строки, которых нет в Sheet2
?
Так что бы ваш Sheet1
был копией Sheet2
, не так ли?
Ну, в любом случае, вот код основного Sub
:
Sub Main()
Set idsToExclude = CreateObject("Scripting.Dictionary"): idsToExclude.CompareMode = TextCompare
'fill dictionary with IDs from sheet 2
Set idsToExclude = CreateDictFromColumns("Sheet2", "A", "B")
'find last populated row
xEndRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'iterate all rows from bottom to top
For i = xEndRow To 2 Step -1
'get value of cell at current row and 1st column
currentCellValue = ActiveSheet.Cells(i, 1).Value
'if row doesnt met criteria, delete it
If Not idsToExclude.Exists(currentCellValue) Then
Rows(i).Delete
End If
Next
End Sub
И Function
для получения идентификаторов и имен от определенного Sheet
:
Function CreateDictFromColumns(sheet As String, keyCol As String, valCol As String) As Object
Set dict = CreateObject("Scripting.Dictionary"): dict.CompareMode = TextCompare
Dim rng As Range
Dim i As Long
Dim lastCol As Long '// for non-adjacent ("A:ZZ")
Dim lastRow As Long
lastRow = Sheets(sheet).Range(keyCol & Sheets(sheet).Rows.Count).End(xlUp).Row
Set rng = Sheets(sheet).Range(keyCol & "1:" & valCol & lastRow)
lastCol = rng.Columns.Count
For i = 2 To lastRow
If (rng(i, 1).Value = "") Then Exit Function
dict.Add rng(i, 1).Value, rng(i, lastCol).Value
Next
Set CreateDictFromColumns = dict
End Function
Примечание: Если вы хотите сделать наоборот(удалите идентификаторы в Sheet1
, которые в Sheet2
), просто удалите оператор Not
из следующей строки:
If Not idsToExclude.Exists(currentCellValue) Then
Как видите, некоторые части жестко запрограммированы. Мое предложение состоит в том, чтобы адаптировать эти части и сделать их более динамичными, я должен был написать это так из-за недостатка рассматриваемых деталей.