Excel VBA运行真的很慢

我有我认为是一个非常简短的VBA Excel脚本，基本上复制数据到另一个工作表，如果有数据，然后显示它，我需要它显示打印。

它运行速度非常慢

正如你所看到的，我试图closures自动计算和屏幕更新。 我觉得这个速度有点快。 但是我认为还需要几分钟的时间。

Sub Button2_Click() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False With Worksheets("sheet2").PageSetup .PaperSize = xlPaperStatement .Orientation = xlLandscape .LeftMargin = Application.InchesToPoints(1.5) .RightMargin = Application.InchesToPoints(0) .TopMargin = Application.InchesToPoints(1.25) .BottomMargin = Application.InchesToPoints(0) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed End With Dim rows, colum, length, i, a, b, c As Integer length = Worksheets("Sheet1").Cells(Worksheets("Sheet1").rows.Count, "A").End(xlUp).Row i = 1 For rows = 3 To length For colum = 4 To 6 If colum = 5 Then GoTo NextIteration End If If IsEmpty(Worksheets("Sheet1").Cells(rows, colum)) Then GoTo NextIteration Else Worksheets("Sheet2").rows(i).RowHeight = 90 Worksheets("Sheet2").rows(i + 1).RowHeight = 3.6 Worksheets("Sheet2").rows(i + 2).RowHeight = 79.6 Worksheets("Sheet2").rows(i + 3).RowHeight = 93.2 a = Len(Worksheets("Sheet1").Cells(rows, colum)) b = InStr(1, Worksheets("Sheet1").Cells(rows, colum), " ") c = a - b + 1 Worksheets("Sheet2").Cells(i, 2).Value = Mid(Worksheets("Sheet1").Cells(rows, colum), InStr(1, Worksheets("Sheet1").Cells(rows, colum), " "), c) Worksheets("Sheet2").Cells(i + 2, 2).Value = Format(Worksheets("Sheet1").Cells(rows, 1), "Medium Time") i = i + 4 End If NextIteration: Next colum Next rows Worksheets("Sheet2").Columns("A:A").ColumnWidth = 13 Worksheets("Sheet2").Columns("B:B").ColumnWidth = 77 Worksheets("Sheet2").Columns("B:B").Font.Name = "David" Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

是否有可能将视图模式设置为页面布局会使其​​减慢？

我已经将其切换回普通视图模式，并且几乎立即工作。

Answer 1

问题是rowheight设置。

最好是一次完成，而不是逐行

考虑下面的代码

 Option Explicit Sub Button2_Click() ' here goes your code for page settings ' ... Dim iRow As Long, j As Long, a As Long, b As Long Dim cell As Range Dim sht2Rows As String, sht2RowsHeight As Variant Dim myVal As Variant Dim sht1 As Worksheet, sht2 As Worksheet 'set a reference to your sheets once and for all! Set sht1 = Worksheets("Sheet1") Set sht2 = Worksheets("Sheet2") sht2RowsHeight = Array(90, 3.6, 79.6, 93.2) ' set needed rows height iRow = 1 For Each cell In sht1.Range("A3", sht1.Cells(sht1.rows.Count, "A").End(xlUp)) 'loop through "Sheet1" column "A" from row 3 to the last non blank row For j = 3 To 5 Step 2 'consider corresponding cells in columns "D" and "F", obtained as offsetted from "A" If Not IsEmpty(cell.Offset(, j)) Then sht2Rows = sht2Rows & "A" & iRow & "," 'update cells references whose row height is to be set myVal = cell.Offset(, j).Value 'store cell value for subsequent operations with it a = Len(myVal) b = InStr(1, myVal, " ") sht2.Cells(iRow, 2).Value = Mid(myVal, b, a - b + 1) sht2.Cells(iRow + 2, 2).Value = Format(cell, "Medium Time") iRow = iRow + 4 End If Next j Next cell ' format Sht2 rows and columns With sht2 'format rows height For j = 0 To 3 .Range(Left(sht2Rows, Len(sht2Rows) - 1)).Offset(j).RowHeight = sht2RowsHeight(j) Next j 'format Columns width .Columns("A:A").ColumnWidth = 13 With .Columns("B:B") .ColumnWidth = 77 .Font.name = "David" End With End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

它以sht2Rows存储要格式化的“第一”行的所有引用，然后将所有“四”行格式化为4个镜头，每个镜头都方便地与“第一个”

它也做了一些代码清理和variables使用优化

还要考虑在任何模块的顶层都使用Option Explicit：牺牲一些额外的工作来使所有的variables变暗，这样你就可以更好地控制代码，debugging时间缩短

Answer 2

对于我来说最好的做法是从页面布局视图切换到正常状态。 我不知道为什么，但现在需要2秒钟，而不是一分钟或更长时间。