検索し、削除VBAコードを最適化する必要が

Question

I持って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 

が列Aからそれぞれの値を取るですCurrentProductsでその製品を検索し、値が見つかった場合はCurrentProductsから行全体を削除するので、CurrentProductsシートに新しい製品が残っています。

このコードは機能しますが、非常に遅く、実行に約5分かかります。

各シートには約30,000行があります。

これを高速化する方法はありますか、それともそれほど多くの行があるからですか？

Answer 1

これは、数式を使用することでこれをもっと早く行うことができると私は示唆しています。たとえば、あなたはvlookupを行うことができます。その後、シートをソートし、値を返した行を削除することができます。

これは1つの解決策です。

私が考えることができる多くの同様のことがあります。しかし、数式を使うのが最も簡単です。

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