Excel VBA運行速度非常慢

Question

我有一個非常簡短的VBA excel腳本，基本上可以將數據複製到另一張紙上，如果那裏有數據，然後顯示它我如何顯示它需要打印。

它運行很慢

正如你可以看到我曾試圖關閉自動計算和屏幕更新。我認爲這會加快一點。但是，我認爲應該花幾分鐘的時間。

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要格式化的「第一」行的所有引用，然後格式化全部完成「四個「行，每個方便地偏離」第一「一個

它也做一些代碼清理和變量使用優化

也可以考慮總是在任何模塊的頂層使用Option Explicit：犧牲一些額外的工作來調暗所有變量，您將獲得更多對代碼的控制權和調試時間的縮短

Answer 2

真正起作用的是最適合我的是從頁面佈局視圖切換到正常的視圖模式。我不知道爲什麼，但現在需要2秒鐘，而不是一分鐘或更長時間。