Excel VBA - 之后插入公式并删除已过滤的行

Question

我想加快以下代码，但我不知道如何开始。是否可以在插入其他公式之前进行vlookup并删除不匹配的行？我认为这会将行数从35.000减少到800.

以下是代码：

Sub INSERTDATA()
Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
Dim rngToCopy As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Worksheets("INPUT").Range("A2:BN35000").ClearContents

For Each wB In Application.Workbooks
    If Left(wB.Name, 17) = "Backorders Detail" Then
        Set Wb1 = wB
        Exit For
    End If
Next

If Not Wb1 Is Nothing Then
    Set wb2 = ThisWorkbook

    With Wb1.Sheets(2)
        Set rngToCopy = .Range("A2:BN2", .Cells(.Rows.Count, "A").End(xlUp))
    End With
    wb2.Sheets("INPUT").Range("A2:BN2").Resize(rngToCopy.Rows.Count).Value = rngToCopy.Value

End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Range("BO3").Formula = "=IF(H3="""","""",CONCATENATE(H3,""/"",TEXT(I3*10,""0000"")))"
Range("BO3").Copy
Range("BO3:BO35000").PasteSpecial (xlPasteAll)

Range("BP3").Formula = "=IF(AN3="""","""",VALUE(AN3))"
Range("BP3").Copy
Range("BP3:BP35000").PasteSpecial (xlPasteAll)

Range("BQ3").Formula = "=VLOOKUP(BP3,DATA!A:L,12,FALSE)"
Range("BQ3").Copy
Range("BQ3:BQ35000").PasteSpecial (xlPasteAll)

Range("BR3").Formula = "=VLOOKUP(BP3,DATA!A:K,11,FALSE)"
Range("BR3").Copy
Range("BR3:BR35000").PasteSpecial (xlPasteAll)

Range("BS3").Formula = "=IF(R3="""","""",LEFT(R3,4))"
Range("BS3").Copy
Range("BS3:BS35000").PasteSpecial (xlPasteAll)

Range("BT3").Formula = "=IF(W3="""","""",W3)"
Range("BT3").Copy
Range("BT3:BT35000").PasteSpecial (xlPasteAll)

Range("BU3").Formula = "=IF(W3="""","""",W3)"
Range("BU3").Copy
Range("BU3:BU35000").PasteSpecial (xlPasteAll)

Range("BV3").Formula = "=IF(BH3="""","""",BH3)"
Range("BV3").Copy
Range("BV3:BV35000").PasteSpecial (xlPasteAll)

Range("BW3").Formula = "=IF(AF3="""","""",AF3)"
Range("BW3").Copy
Range("BW3:BW35000").PasteSpecial (xlPasteAll)

Range("BX3").Formula = "=IF(A3="""","""",IF(ISERROR(BQ3),""x"",""""))"
Range("BX3").Copy
Range("BX3:BX35000").PasteSpecial (xlPasteAll)

Selection.AutoFilter Field:=10, Criteria1:="x"
lr = Cells(Rows.Count, 1).End(xlUp).Row
If lr > 1 Then
    Range("A3:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If

End Sub

对不起这个“装扮”代码，但这就是我自己一起推出的代码。