更快地将excel报告打印到pdf

Question

我正在尝试在 Excel 中打印一份报告，我需要它能够快速打印。就目前而言，它需要永远经历。每个报告每天大约有 1 到 2000 行数据。这是报告的vba。我有什么可以改变的，以使打印到 pdf 的功能在更短的时间内发生？

Sub TestRun()
Dim rSheet As Worksheet
Dim sSheet As Worksheet
Dim mSheet As Worksheet
Dim rRow As Long
Dim sRow As Long
Dim iRow As Long
Dim nRow As Long
Dim mRow As Long
Set mSheet = ThisWorkbook.Worksheets("Report")
Set rSheet = ThisWorkbook.Worksheets("Received")
Set sSheet = ThisWorkbook.Worksheets("Shipped")
rRow = rSheet.Cells(Rows.Count, 1).End(xlUp).Row
sRow = sSheet.Cells(Rows.Count, 1).End(xlUp).Row
mRow = mSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1
mSheet.Range("A7:G" & mRow).ClearContents
mRow = mSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
With rSheet
    .Range("A1:N" & rRow).AutoFilter Field:=6, Criteria1:=">=" & Sheet5.Range("B3"), Operator:=xlAnd, _
                                Criteria2:="<=" & Sheet5.Range("B4")
    .Range("F2:F" & rRow).Copy
        mSheet.Range("A" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("B2:B" & rRow).Copy
        mSheet.Range("B" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("J2:J" & rRow).Copy
        mSheet.Range("C" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("D2:D" & rRow).Copy
        mSheet.Range("D" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("N2:N" & rRow).Copy
        mSheet.Range("E" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("A2:A" & rRow).Copy
        mSheet.Range("G" & mRow).PasteSpecial Paste:=xlPasteValues
    .AutoFilterMode = False
End With
mRow = mSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
With sSheet
    .Range("A1:N" & rRow).AutoFilter Field:=6, Criteria1:=">=" & Sheet5.Range("B3"), Operator:=xlAnd, _
                                Criteria2:="<=" & Sheet5.Range("B4")
    .Range("F2:F" & rRow).Copy
        mSheet.Range("A" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("B2:B" & rRow).Copy
        mSheet.Range("B" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("J2:J" & rRow).Copy
        mSheet.Range("C" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("D2:D" & rRow).Copy
        mSheet.Range("D" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("N2:N" & rRow).Copy
        mSheet.Range("E" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("A2:A" & rRow).Copy
        mSheet.Range("G" & mRow).PasteSpecial Paste:=xlPasteValues
    .AutoFilterMode = False
End With
For i = 7 To mRow
    mSheet.Cells(i, "F") = mSheet.Cells(i, "D") * mSheet.Cells(i, "E")
Next
mRow = mSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
mSheet.Range("D" & mRow + 3) = "TOTAL GROSS LBS"
mSheet.Range("E" & mRow + 3) = "TOTAL DAYS"
mSheet.Range("F" & mRow + 3) = "TOTAL BILLABLE LBS"
mSheet.Range("D" & mRow + 4) = Application.WorksheetFunction.Sum(mSheet.Range("D7:D" & mRow))
mSheet.Range("E" & mRow + 4) = Application.WorksheetFunction.Sum(mSheet.Range("E7:E" & mRow))
mSheet.Range("F" & mRow + 4) = Application.WorksheetFunction.Sum(mSheet.Range("F7:F" & mRow))
If Not Right(Sheet5.Range("B2"), 1) = "\" Then Sheet5.Range("B2") = Sheet5.Range("B2") & "\"
mSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Sheet5.Range("B2") & "\" & Sheet5.Range("D2"), Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
End Sub

工作表链接：https://mega.co.nz/#!7oRCkQgT!cTzSXQ28oZ5UR_DCkIRJ8BegYEAKqQXN_PLgyQjIJtI

Answer 1

一个明显的改进是避免使用PasteSpecial 方法，你可以这样做，它应该更快一点：

mSheet.Range("A" & mRow).Value = .Range("F2:F" & rRow).Value

我确信它会更快，但我没有测试它的性能。

此外，这个块在 2000 行数据上可能很耗时（我使用 volatile Rand 函数进行的简单测试大约需要 20-25 秒。

For i = 7 To mRow
    mSheet.Cells(i, "F") = mSheet.Cells(i, "D") * mSheet.Cells(i, "E")
Next

通常，在内存中执行算术比在工作表对象上更快。所以让我们测试一下快多少。我的第一种方法使用上面的方法：直接将一个单元格值写为其他两个单元格值的乘积：

Sub testRangeMultiplication()
Dim i As Integer, mrow As Integer

mrow = 2000

Range("B1:C2000").Formula = "=Rand()"

Debug.Print "Start range multiplication: " & TimeValue(Now)
For i = 1 To 2000

    Cells(i, "A").Value = Cells(i, "B").Value & Cells(i, "C").Value

Next
Debug.Print "End range multiplication: " & TimeValue(Now)

End Sub

将 2000 个单独的单元格值写入循环内的 2000 个操作需要 20-25 秒。

替代方法首先将范围复制到一个数组，并在内存中进行所有数学运算，然后写入工作表一次。因为访问工作表很昂贵（内存方面），所以最好尽量减少与它交互的频率。此方法在不接触工作表的情况下执行“循环”，并且只向工作表写入一次，而不是 2000 次。

完成相同数量的数学运算只需要 不到 2 秒：

Sub testArrayMultiplication()
Dim i As Integer, mrow As Integer
Dim arr As Variant

mrow = 2000

Range("B1:C2000").Formula = "=Rand()"

arr = Range("A1:C2000").Value

Debug.Print "Start array multiplication: " & TimeValue(Now)
For i = 1 To 2000

    arr(i, 1) = arr(i, 2) * arr(i, 3)

Next
Range("A1:C2000").Value = arr
Debug.Print "End array multiplication: " & TimeValue(Now)

End Sub

因此，一个简单的更改可将您的循环速度提高约 95%。

其他明显的建议还包括禁用屏幕更新（Application.ScreenUpdating = False 在 sub 开头，=True 在结尾）以及暂时禁用计算（Application.Calculation = xlCalculationManual 在开头，然后 =xlCalculationAutomatic 在结尾子）。