宏观效率与进度条

Question

我有 2 个宏，其中第一个宏询问我希望插入多少行，然后调用下面的第二个宏。这个设置效果很好，但是，如果我想添加 100 行，则需要一些时间才能完成，并且会给用户一种 excel 已损坏的印象。

我计划添加一个进度条，但在尝试该功能之前，我想知道是否有更好的方法来使我的第二个宏更高效。我不是专家，但我不觉得我对宏要求太多而使其运行缓慢。 注意：我可能偏离了基地，但在我看来，这应该在几秒钟内运行，而不是几分钟。

任何见解都值得赞赏。

Sub vdc_InsertRow_Inventory()


'Adds new row
    Worksheets("INVENTORY").Range("B8").EntireRow.Insert
    
'Clears all combo boxes back to default
    Worksheets("INVENTORY").Range("B5:AI5").Select
    Selection.ClearContents

'Add default value to PRICING fields
    Worksheets("INVENTORY").Range("C8").Value = "Not Started"
    

'Add default value to EXPENSES fields
    Worksheets("INVENTORY").Range("P8").Formula = "=XLOOKUP(1,(LOOKUP2!$B$7:$B$100=H8) * (LOOKUP2!$C$7:$C$100=I8) * (LOOKUP2!$D$7:$D$100=J8) * (LOOKUP2!$E$7:$E$100=K8),LOOKUP2!$H$7:$H$100,0)"
    Worksheets("INVENTORY").Range("Q8").Formula = "=SUPPLIES!$E$12"
    
'Add default value to SHIPPING fields
    Worksheets("INVENTORY").Range("S8").Formula = "=XLOOKUP($R8, SHIP!$H$7:$H$938, SHIP!$I$7:$I$938,"""")"
    Worksheets("INVENTORY").Range("U8").Formula = "=XLOOKUP($T8, SHIP!$C$7:$C$41, SHIP!$F$7:$F$41,"""")"


'Add default value to FEES fields
    Worksheets("INVENTORY").Range("X8").Formula = "=FEES!$C$4*($D8+$E8+$F8)"
    Worksheets("INVENTORY").Range("Y8").Formula = "=IF($C8=""Not Started"",0,IF([@Price]+[@Ship]>9.99,FEES!$C$6,FEES!$C$5))"
    Worksheets("INVENTORY").Range("Z8").Formula = "=IF(COUNTIF($C23:$C$52,""Active"")>250,FEES!$C$8,FEES!$C$7)"
    Worksheets("INVENTORY").Range("AB8").Formula = "=$F8"
     
'Add default value to GRADING fields
    Worksheets("INVENTORY").Range("AF8").Formula = "=IF(AC8>0,GRADING!$D$15,0)"
     
'Scroll screen back to starting range in worksheet
    ActiveWindow.ScrollColumn = 1
    Range("B8").Select
    
End Sub

Answer 1

试试这个：

Sub Tester()
    vdc_InsertRow_Inventory 10
End Sub


Sub vdc_InsertRow_Inventory(numRows As Long)

    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("INVENTORY")
    
    ws.Range("B5:AI5").ClearContents 'Clear combo boxes back to default
    
    Application.Calculation = xlCalculationManual 'turn off automatic calculation
    ws.Range("B8").Resize(numRows).EntireRow.Insert
    With ws.Rows(8).Resize(numRows)
        .Columns("C").Value = "Not Started" 'Add default value to PRICING fields
        .Columns("P").Formula = "=XLOOKUP(1,(LOOKUP2!$B$7:$B$100=H8) * " & _
                                "(LOOKUP2!$C$7:$C$100=I8) * (LOOKUP2!$D$7:$D$100=J8) * " & _
                                "(LOOKUP2!$E$7:$E$100=K8),LOOKUP2!$H$7:$H$100,0)" 'EXPENSES fields
        .Columns("Q").Formula = "=SUPPLIES!$E$12"
        .Columns("S").Formula = "=XLOOKUP($R8, SHIP!$H$7:$H$938, SHIP!$I$7:$I$938,"""")" 'SHIPPING fields
        .Columns("U").Formula = "=XLOOKUP($T8, SHIP!$C$7:$C$41, SHIP!$F$7:$F$41,"""")"
        .Columns("X").Formula = "=FEES!$C$4*($D8+$E8+$F8)" 'FEES
        .Columns("Y").Formula = "=IF($C8=""Not Started"",0,IF([@Price]+[@Ship]>9.99,FEES!$C$6,FEES!$C$5))"
        .Columns("Z").Formula = "=IF(COUNTIF($C23:$C$52,""Active"")>250,FEES!$C$8,FEES!$C$7)"
        .Columns("AB").Formula = "=$F8"
        .Columns("AF").Formula = "=IF(AC8>0,GRADING!$D$15,0)" 'GRADING fields
    End With
    Application.Calculation = xlCalculationAutomatic 'reset to auto
    
    ws.Select
    ActiveWindow.ScrollColumn = 1
    ws.Range("B8").Select
    
End Sub