更快速地打印excel报告到pdf
我试图在Excel中打印报告，我需要它能够快速打印。 就目前而言，这需要永远的经历。 每个报告每天大约有一到两千行数据。 这是报告的vba。 任何我可以改变，使印刷到PDFfunction发生在更less的时间？
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
一个明显的改进是避免了PasteSpecial方法，你可以这样做，而应该快一点：
mSheet.Range("A" & mRow).Value = .Range("F2:F" & rRow).Value
我确信它会更快，但是我没有testing它的性能。
而且，这个块在2000行的数据上可能是耗时的（简单的testing我花了大约20-25秒，挥发性的Rand函数。
For i = 7 To mRow mSheet.Cells(i, "F") = mSheet.Cells(i, "D") * mSheet.Cells(i, "E") Next
通常，在内存中执行算术运算速度更快，而不是工作表对象。 所以我们来testing一下速度。 我有第一种方法使用上面的方法：直接写一个单元格值作为两个其他单元格的值的乘积：
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-25秒，在循环内写入2000个单元值作为2000个操作。
替代方法首先将范围复制到一个数组，然后在内存中执行所有的math运算，然后写入工作表一次 。 因为访问工作表是昂贵的（记忆方面），所以最好尽量减less与之交互的频率。 此方法执行“循环”而不接触纸张，只写入纸张一次，而不是2000次。
做相同math的时间less于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％。
其他明显的build议还包括禁用屏幕更新（ Application.ScreenUpdating = False在子开始和=True在最后），也暂时禁用计算（ Application.Calculation = xlCalculationManual在开始，然后=xlCalculationAutomatic在子）。