Question

我有一张带有2张（ProductList和CurrentProducts）的Excel工作簿

我有以下代码：

Sub Macro1()

Dim Lastrow As Integer
Dim x As Integer
Dim BinNo As String
Dim MyCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Lastrow = Sheets("ProductsList").Range("A65536").End(xlUp).Row

For x = Lastrow To 2 Step -1

BinNo = Sheets("ProductsList").Range("A" & x).Value

With Sheets("CurrentProducts").Range("A:A")
    Set MyCell = .Find(What:=BinNo, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)

    If Not MyCell Is Nothing Then
        Sheets("CurrentProducts").Range(MyCell.Address).EntireRow.Delete
    End If
 End With

Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

这样做是从ProductList中的A列中获取每个值，在CurrentProducts中搜索它，如果找到该值，则从CurrentProducts中删除整行，这样我就可以在CurrentProducts表中留下任何新产品。

此代码有效但速度很慢，大约需要5分钟才能运行。

每张纸都有大约30,000行。

有没有办法加快速度，或者只是因为行数太多了？

Answer 1

我建议通过使用公式可以更快地完成这项工作。例如，你可以做一个vlookup。然后，您可以对工作表进行排序并删除任何返回值的行。

这是一种可能的解决方案。

我能想到许多类似的事情。但使用公式将是最简单的。

Answer 2

您可以尝试这样的事情......

Sub DeleteRows()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr As Long
Application.ScreenUpdating = False
Set ws1 = Sheets("ProductsList")
Set ws2 = Sheets("CurrentProducts")

With ws2
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    .Columns(1).Insert
    .Range("A2:A" & lr).Formula = "=IF(COUNTIF(" & ws1.Name & "!A:A,B2),NA(),"""")"
    On Error Resume Next
    .Range("A2:A" & lr).SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
    .Columns(1).Delete
End With
Application.ScreenUpdating = True
End Sub

搜索和删除vba代码需要优化

2 个答案: