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

вопрос - это установка на рассылке.

это лучше всего сделать в одном кадре, а не построчно

рассмотрим следующий код

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 выстрела, каждый удобно компенсируя от„первого“один

это также делает некоторые очищающие кода и параметров оптимизации Usage

также всегда рассматривают возможность использования Option Explicit в самом топо любого модуля: за счет некоторой дополнительной работы, чтобы уменьшить все переменные, вы получите гораздо больше контроля над своим кодом и сократите время отладки

Answer 2

Что действительно сработало Лучше всего было переключить режим просмотра в нормальное состояние с макета страницы. Я не знаю почему, но теперь он занимает 2 секунды по сравнению с минутой или более.