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

我有一个Excel工作簿2片（产品列表和CurrentProducts）搜索和删除VBA代码需要优化

我有以下代码：

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

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

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

每页有大约30,000行。

有没有办法加快速度，还是仅仅因为有这么多行？

来源

2017-04-12 Gazza

如果代码工作，你需要优化/审查，那么你应该将它张贴在**代码审查**部分，点击：http：/ /codereview.stackexchange.com/ –

我将此问题标记为偏离主题，因为它应该按照此处的规定迁移到CodeReview：http://meta.stackoverflow.com/questions/266749/migration-of-code-questions从堆栈溢出到代码复审原因：代码正在工作，并且OP本身要求改进工作代码的性能。没有错误或错误需要克服。 – Ralph

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

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

我可以想到很多类似的东西。但使用公式将是最简单的。

来源

2017-04-12 08:04:47 ClintB

你可以试试这样的事情...

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

来源

2017-04-12 08:14:14 sktneer

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

回答

相关问题