excel - Excel - 在 2 个列表中搜索列表

Question

我有 2 个列表，每个列表都在自己的工作表上。

我的目标是在第一张纸的每个单元格上搜索第二张纸的每个单元格，如果找到，则删除第一张纸的整行。

单元格的内容不一定相同，只能是字符串。

例如，工作表 2 中的一个单元格是“字符串”，但如果第一个工作表中的一个单元格是“子字符串”，它应该删除第一个工作表的整行。

我应该如何通过 VBA 处理它？

谢谢！

Answer 1

如果是“一次性”操作，请执行“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 2

对于 Sheet2 列中的每个单元格，在工作表 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 3

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

Answer 4

试试下面的代码：

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