VBA 代码耗时过长 og Excel 停止响应

Question

我编写了一段代码，它从一个 sheet 复制一个模板并将其粘贴到另一个 sheet 中，并使用一个新变量来触发模板中的函数，我目前有 115 个变量我需要并且使用“DoEvents”花费的时间太长，没有它 excel 停止响应。有什么办法可以优化代码吗？最后，我复制并粘贴为值，以便在文件中保存 space。

“rng”中存储的变量

代码如下：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Flight FS").SelectSheets("Flight FS").Range("c1048576").Select
Selection.End(xlUp).Select
Sheets("Flight FS").Range(ActiveCell, Sheets("Flight FS").Range("C6").End(xlToRight)).Select
Selection.Clear

Dim rng As Range, cell As Range

Set rng = Sheets("Flight FS templ").Range("c45", Sheets("Flight FS 
templ").Range("c45").End(xlDown))



For Each cell In rng
Sheets("Flight FS templ").Select
Sheets("Flight FS templ").Range("c6", Sheets("Flight FS 
templ").Range("i40").End(xlToRight)).Select
Selection.Copy
Sheets("Flight FS").Select
Range("c1048576").Select
Selection.End(xlUp).Select
ActiveCell.Offset(rowoffset:=2, columnoffset:=0).Activate
ActiveSheet.Paste
ActiveCell.Offset(rowoffset:=1, columnoffset:=3).Activate
ActiveCell.Value = cell
DoEvents
Next cell

Application.Calculation = xlCalculationAutomatic
Sheets("Flight FS").Select
Sheets("Flight FS").Range("c1048576").Select
    Selection.End(xlUp).Select
    Sheets("Flight FS").Range(ActiveCell, Sheets("Flight 
FS").Range("C6").End(xlToRight)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

ActiveSheet.Range("A2").Select

Application.CutCopyMode = False

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

Answer 1

如何避免`Select`

未测试。代码可以编译，但这并不意味着它可以工作。感谢您的反馈。
我不知道源范围中的公式是什么，但如果它们是 'slowing down' 您的工作簿，它们应该在 VBA 中计算。

Option Explicit

Sub GenerateData()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the destination worksheet, reference the last cell,
    ' reference and clear the destination range and reference
    ' the destination last cell (see the offsets later in the code).
    Dim dws As Worksheet: Set dws = wb.Worksheets("Flight FS")
    Dim dCell As Range: Set dCell = dws.Cells(dws.Rows.Count, "C").End(xlUp)
    Dim drg As Range ' (left-bottom, top-right)
    Set drg = dws.Range(dCell, dws.Cells(6, dws.Columns.Count).End(xlToLeft))
    drg.Clear
    Set dCell = drg.Cells(1).Offset(-1)
    
    ' Reference the source worksheet, reference the source column range,
    ' reference the source range and calculate the destination offset.
    Dim sws As Worksheet: Set sws = wb.Worksheets("Flight FS templ")
    Dim scrg As Range
    Set scrg = sws.Range("C45", sws.Cells(sws.Rows.Count, "C").End(xlUp))
    Dim srg As Range
    With sws.Range("C6", sws.Cells(6, sws.Columns.Count).End(xlToLeft))
        Set srg = .EntireColumn.Rows("6:40")
    End With
    Dim drOffset As Long: drOffset = srg.Rows.Count + 1
    
    Application.ScreenUpdating = False
    ' Prevent the formulas from the copied source ranges being calculated.
    Application.Calculation = xlCalculationManual
    
    ' Loop through the cells of the source column range.
    Dim scCell As Range
    For Each scCell In scrg.Cells
        dCell.Offset(1, 3).Value = scCell.Value ' this value is what the...
        srg.Copy dCell.Offset(2) ' ... formula-infested source range depends on
        Set dCell = dCell.Offset(drOffset) ' reference the next last cell
    Next scCell
    
    ' It may take a while after turning on calculation.
    Application.Calculation = xlCalculationAutomatic
    
    ' Replace the formulas with values.
    Set drg = dws.Range(dCell, dws.Cells(6, dws.Columns.Count).End(xlToLeft))
    drg.Copy
    drg.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    
    ' A Final Touch
    dws.Range("A2").Select
    
    Application.ScreenUpdating = True

    MsgBox "Data generated.", vbInformation

End Sub

VBA 代码耗时过长 og Excel 停止响应

VBA code takes too long og Excel stops responding

excel

optimization

performance

vba

如何避免`Select`

VBA 代码耗时过长 og Excel 停止响应

VBA code takes too long og Excel stops responding

excel

optimization

performance

vba

如何避免Select

如何避免`Select`