Excel VBA运行非常慢

Excel VBA运行非常慢,vba,excel,Vba,Excel,我有一个我认为很短的VBA excel脚本,它基本上是将数据复制到另一个工作表(如果有数据),然后以我需要的方式显示以进行打印 它跑得很慢 如你所见,我已尝试关闭自动计算和屏幕更新。我想这会加快速度。但我认为还需要几分钟的时间 Sub Button2_Click() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False With Worksheets("sheet2").Page

我有一个我认为很短的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
是否可能将视图模式设置为页面布局会使其速度减慢


我已将其切换回正常查看模式,它几乎可以立即工作。

问题在于行高设置

最好一次完成,而不是一排一排地完成

考虑以下代码

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个快照中格式化所有“四”行,每个快照方便地与“第一”行偏移

它还进行一些代码清理和变量使用优化


还考虑始终在任何模块的Topo上使用选项显式:以一些额外的工作为代价,使所有变量变暗,您将获得更多的代码控制和调试时间,缩短

> P>真正有效的对我来说最好是从页面布局视图将视图模式切换回正常。我不知道为什么,但与一分钟或更长时间相比,现在需要2秒。

打印机通信会减慢速度;尤其是当它是无线打印机、网络打印机或进入“待机”模式的打印机时。首先设置打印机(最好是写入pdf或写入文件)并优化代码。之后的一切都只是打印机通信延迟。长度的典型值(Sheet1中的行数)是多少?因此我尝试将打印机更改为写入pdf格式,这对其他人有帮助!持续改进。典型长度为38行到最多60行。顺便说一句,虽然故意错拼
消除了它与属性的混淆,但a和a属性都可能产生歧义。完全同意@Jeeped。需要注意的是,一些
.PageSetup
属性可能非常慢。如果您可以只运行一次代码块,而不是每次单击,那么您的例程可能会大大加快。