Excel - список поиска в 2 списках

Question

У меня есть 2 списка, каждый на своем листе.

Моя цель - поиск каждой ячейки второго листа в каждой ячейке первого листа и удаление всей строки первого листа, если оно было найдено.

Содержимое ячейки не обязательно одно и то же, это может быть только строка.

Например, одна из ячеек на листе 2 является «строкой», но если одна из ячеек в первом листе является «подстрокой», она должна удалить всю строку первого листа.

Как подойти к нему через VBA?

Спасибо!

Answer 1

Try ниже код:

Sub sample() 
    Dim lastRowSheet1 As Long, lastRowSheet2 As Long, rng As Range, r As Range, i As Integer, j As Integer 
    lastRowSheet2 = Sheets("Sheet2").Range("A65000").End(xlUp).Row ' total row sheet 2 
    lastRowSheet1 = Sheets("Sheet1").Range("A65000").End(xlUp).Row ' total row sheet 1 

    For j = 1 To lastRowSheet2  'loop thru every cell of sheet 2 
     For i = 1 To lastRowSheet1 ' loop thru every cell of sheet 1 
      If InStr(1, Sheets("Sheet1").Cells(i, 1).Value, Sheets("Sheet2").Cells(j, 1).Value) > 0 Then 
       Sheets("Sheet1").Cells(i, 1).EntireRow.Delete 
       Exit For 
      End If 
     Next 
    Next 
End Sub 

Answer 2

Если это операция «одного выстрела», сделайте «VLOOKUP» и используйте фильтры для удаления найденных строк.

В VBA это сделать что-то вроде:

for i = 1 to 65535 
    for j = 1 to 65535 
     if sheets("sheet1").range("A" & i).value = sheets("sheet2").range("A" & j).value then 
       sheets("sheet1").range("A" & i).EntireRow.Delete 
     end if 
    next j 
next i 

Answer 3

Для каждой ячейки в столбце в Лист2, обратите внимание на частичное совпадение в колонке в листе 1. Удалить всю строку, если есть совпадение, затем повторяйте до тех пор, пока совпадение не будет найдено

Это предполагает, что ваши списки организованы в 1 столбец на каждом листе.

Sub InCellDeDupe() 

Dim sh1 As Worksheet 
Dim sh2 As Worksheet 

Dim rng1 As Range 
Dim rng2 As Range 
Dim foundRow As Range 

Dim r As Long 
Dim cl As Range 
Dim str As String 

Set sh1 = Worksheets("Sheet 1") '<-- modify as needed 
Set sh2 = Worksheets("Sheet 2") '<-- modify as needed 

Set rng1 = sh1.UsedRange.Columns(1) '<-- modify as needed 
Set rng2 = sh2.UsedRange.Columns(1) '<-- modify as needed 

For Each cl In rng2 
    str = cl.Value 

    Do 
     Set foundRow = rng1.Find(What:=str, After:=rng1.Cells(1, 1), LookIn:=xlValues, _ 
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
      MatchCase:=False, SearchFormat:=False) 

      If Not foundRow Is Nothing Then 
       foundRow.EntireRow.Delete 
      Else: 
       Exit Do 
      End If 
    Loop 
Next 
End Sub 

Answer 4

Метод mansuetus предложил бы очень медленно, так как ему придется перебирать все 65K на строки 65k раз и не найти подстроки.

Для повышения производительности вы должны динамически искать длину данных и сохранять их. Что касается вопроса о поиске подстроки вы могли бы использовать что-то вроде этого:

If FullCellString = LookupStr Then 
     'Match found - delete row 
    Else 
     If InStr(1, FullCellString, LookupStr, vbTextCompare) > 0 Then 
      'Match found in substring delete row 
     End If 
    End If