Question

我试图在Excel中打印报告，我需要它才能快速打印。现在需要永远经历。每个报告每天大约有一到两千行数据。这是报告的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行数据上可能非常耗时（我使用易变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

将20个单独的单元格值写入循环内的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％。

其他明显的建议还包括禁用屏幕更新（在{sub}开始时为Application.ScreenUpdating = False，在结尾为=True）并暂时禁用计算（Application.Calculation = xlCalculationManual在开头，然后{{ 1}}在sub的末尾）。

将excel报告打印到pdf更快

1 个答案: