Question

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

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

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

例如，工作表2中的一个单元格为“string”，但如果第一个工作表中的一个单元格为“substring”，则应删除第一个工作表的整行。

我应该如何通过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

enter image description here

Excel - 2个列表中的搜索列表

4 个答案: