☰

如何优化 VBA 宏

tag-icon • tag-icon microsoft-excel vba macros
如何优化 VBA 宏

我需要您帮助我在 Excel 中优化此宏。我正在使用它来生成我们医院化疗药物标签的数据。该宏现在运行良好，但有时需要很长时间才能生成。这是一个非盈利项目，当然我没有得到管理层的帮助。如果您有任何建议或帮助，我将不胜感激。

Dim i, iLastRow, d As Integer
Dim date1, date2 As Date
Dim oLastRow As ListRow
Dim srcRow As Range
Dim date_tabela As Date
Dim ile_dawek As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.StatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
date1 = Worksheets("Program").Range("E2")
date2 = Worksheets("Program").Range("E3")
iLastRow = Worksheets("Program").ListObjects("Program").ListRows.Count + 6
For i = 7 To iLastRow
date_tabela = Cells(i, 4).Value
ile_dawek = Cells(i, 11).Value 
    If date_tabela >= date1 And date_tabela <= date2 Then
        For d = 1 To ile_dawek
            Set srcRow = Worksheets("Program").ListObjects("Program").Range.Range(Cells(i - 5, 1), Cells(i - 5, 36))
            Set oLastRow = Worksheets("Etykiety").ListObjects("Etykiety_druk").ListRows.Add()
            srcRow.Copy
            oLastRow.Range.PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False

        Next
     End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = True
Application.EnableEvents = True
ActiveWorkbook.Save
End Sub

答案1

加快执行速度的一种方法是避免在循环中反复计算相同的值。

例子：

Worksheets("Program").ListObjects("Program").Range

将其分配给一个变量（例如：programRange）并使用该变量进行子范围选择。您可以对 oLastRow 表达式执行相同操作。

其次，由于某些计算依赖于日期比较，因此如果测试失败，您可以避免计算不需要的值。您可以在 IF 语句中设置“ile_dawek”。

当然还有其他优化，但需要更多的分析。

当然，在循环之前进行分配。

答案2

一件简单的事情

Dim i, iLastRow, d As Integer
Dim date1, date2 As Date
Dim oLastRow As ListRow
Dim srcRow As Range
Dim date_tabela As Date
Dim ile_dawek As Integer

多次声明的变量没有被赋予类型，只有最后一个是 - 你需要

Dim i as long, iLastRow as long, d as long

当你没有定义变量时，VBA 会将其声明为变体， 哪个是对象：

表现。使用 Object 类型声明的变量足够灵活，可以包含对任何对象的引用。但是，当您对此类变量调用方法或属性时，总是会导致后期绑定（在运行时）。要强制早期绑定（在编译时）并获得更好的性能，请使用特定的类名声明变量，或将其转换为特定的数据类型。

如果不声明变量，您可能会付出代价。

答案3

要优化代码，有一些通用规则：
- 使用局部变量而不是完全限定的引用
- 用适当的类型声明变量，而不是变体
- 在循环中，将代码移动到循环外部，这对循环变量来说是不变的

例如，您复制的数据与您要打印的标签数循环无关。因此，您只需复制数据一次（复制到剪贴板）并多次重复使用。

如果您查看我的代码建议，您会发现我没有完全遵循规则；您应该为变量指定确切的类型oLabels。

然后，在使用 时，有一个隐藏得很好的错误源date_tabela = Cells(i, 4).Value。Cells这里依赖于上下文。我已将其替换为.Cells将上下文定义为Worksheet("Program")。

重置CutCopyMode仅是表面性的，最后只能重置一次。

代码现在如下所示：

Sub print_doses()
    Dim i As Integer, iLastRow As Integer
    Dim date1 As Date, date2 As Date
    Dim oLastRow As ListRow
    Dim srcRow As Range
    Dim date_tabela As Date
    Dim d As Integer, ile_dawek As Integer
    Dim oLabels

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False

    Set oLabels = Worksheets("Etykiety").ListObjects("Etykiety_druk").ListRows
    With Worksheets("Program")
        date1 = .Range("E2")
        date2 = .Range("E3")
        iLastRow = .ListObjects("Program").ListRows.Count + 6
        For i = 7 To iLastRow
            date_tabela = .Cells(i, 4).Value
            If date_tabela >= date1 And date_tabela <= date2 Then
                ile_dawek = .Cells(i, 11).Value
                Set srcRow = .ListObjects("Program").Range.Range(Cells(i - 5, 1), Cells(i - 5, 36))
                srcRow.Copy
                For d = 1 To ile_dawek
                    Set oLastRow = oLabels.Add()
                    oLastRow.Range.PasteSpecial xlPasteValuesAndNumberFormats
                Next
            End If
        Next i
        Application.CutCopyMode = False
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = ""
    Application.EnableEvents = True
    ActiveWorkbook.Save
End Sub

相关内容