如何删除某些范围

Question

问题：如何查找G列中未包含在A列中的所有单元格？

情况： 我有2列数据。它们包括（除了+/- 3000行）相同的数据。其中一列约为7k行，另一列约为10k行。没有空格。两列均由10位数字的单元格组成，并按升序排序。 A列中的单元格值可能在G列中，也可能不在G列中，反之亦然。

我需要删除G列中未包含在A列中的所有单元格。

我尝试了以下内容：

Sub Delete_rows()

Dim p As Long
Dim LastRow As Long
Dim g As Long

Worksheets("Vergleich").Activate
Range("A2").Select
LastRow = Cells.SpecialCells(xlCellTypeLastCell).row

For g = 1 To LastRow
    'ActiveCell is the first cell in column A, 6 positions to the right is 
    'column G
    If ActiveCell.value = ActiveCell.Offset(0, 6).value Then
        ActiveCell.Offset(1, 0).Select
    Else
        'As I ve said there are numbers in column A that are no contained in 
        'column G which is why I ve tried to work arround this one but ofc 
        'this is not an elegant solution.
        If ActiveCell.value = 4225201001# Then
            ActiveCell.Offset(1, 0).Select
        Else
            'selects the cell in column G that is not contained in column A.
            Range(ActiveCell.Offset(0, 6), ActiveCell.Offset(0, 9)).Select
            Selection.Delete
            ActiveCell.Offset(0, -6).Select
        End If
    End If

Next g

End Sub

这不起作用，因为它不会将A列中未包含在G列中的少数值考虑在内。

请注意，列中可能存在重复的数字。我知道我的代码中有很多选择和活动单元，但请记住我对vba相当新，我发现以这种方式调试代码更容易，因为你可以直观地看到程序正在逐步完成的工作。

由于excel文件很大，我需要一个有效的解决方案来解决我的问题，不过宏会永远运行。

提前感谢您的帮助。

祝你好运

这是运行推荐宏后的屏幕截图。

Answer 1

这正是Application.Match函数的设计目的。

此外，无需使用ActiveCell，ActiveCell.Offset(1, 0).Select和Selection.Delete，您可以使用完全限定的对象直接修改/删除对象。

<强>代码

Option Explicit

Sub Delete_rows()

Dim LastCell As Range, MatchRng As Range
Dim p As Long, g As Long, LastRow As Long

Application.ScreenUpdating = False

With Worksheets("Vergleich")
    ' safest way to get the last row
    Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
                        searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False)
    If Not LastCell Is Nothing Then
        LastRow = LastCell.Row
    Else
        MsgBox "Error! worksheet is empty", vbCritical
        End
    End If

    ' set the range where we want to look for the match
    Set MatchRng = .Range("A1:A" & LastRow)

    ' always loop backwards when deleting cells
    For g = LastRow To 1 Step -1
        ' current value in column "G" is not found in column "B" >> delete this record
        If IsError(Application.Match(.Range("G" & g).Value, MatchRng, 0)) Then
            .Range("G" & g).Delete xlShiftUp
        End If
    Next g
End With

Application.ScreenUpdating = True

End Sub

编辑1 ：更快捷的方法是使用DelRng对象一次性删除整个单元格，从列中添加另一个单元格＆＃34; G＆＃34;在这个范围内，每次都没有在＃34; A＆＃34;列中找到。

代码的修改部分

Dim DelRng As Range

' always loop backwards when deleting cells
For g = LastRow To 1 Step -1
    ' current value in column "G" is not found in column "B" >> delete this record
    If IsError(Application.Match(.Range("G" & g).Value, MatchRng, 0)) Then
        If Not DelRng Is Nothing Then
            Set DelRng = Application.Union(DelRng, .Range("G" & g))
        Else
            Set DelRng = .Range("G" & g)
        End If
    End If
Next g

' delete the entire cells at once >> save run-time
If Not DelRng Is Nothing Then DelRng.Delete xlShiftUp