0

我的程序执行速度很慢，它的工作是在工作簿中格式化工作表。主要是调整行高和列宽，为列应用数字格式，平面冻结和删除自动过滤器。它很长，我已经删除了几个类似的部分以缩短它以用于 stackoverflow，但没有大循环，excel 工作簿只有几张工作表，我试图用计时器识别性能缓慢的部分，但没有运气。有任何想法吗？这些操作中的任何一个都特别慢吗？格式化工作表大约需要 1 分 20 秒。它与处理单元格中数据的其他程序非常相似，似乎很长，用于外观调整。

'Procedure to format sheets
Private Sub FormatSheets()
Dim ShHead(1 To 22) As Variant
Dim ShHead2(1 To 19) As Variant
Dim i As Long
Dim Sh As Worksheet

'Creates array of column Headers for sheets "Data", "Process", "Delete"
ShHead(1) = "BizReg_UUK": ShHead(2) = "VDVV_UUK1": ShHead(3) = "VDVV_UUK"
ShHead(4) = "VDVV_NMK": ShHead(5) = "BizReg_Nos": ShHead(6) = "VDVV_Nos"
ShHead(7) = "BizReg_NACE1_2_red": ShHead(8) = "VDVV_NACE_2_red": ShHead(9) = "Nace maiņa"
ShHead(10) = "Nace maiņas avots": ShHead(11) = "BizReg_LKV": ShHead(12) = "VDVV_LKV"
ShHead(13) = "AVG Apgr.": ShHead(14) = "AVG Darb.": ShHead(15) = "VDVV_Adr"
ShHead(16) = "Struktūras": ShHead(17) = "Sākums": ShHead(18) = "Beigas"
ShHead(19) = "Nodarbošanās": ShHead(20) = "NACE": ShHead(21) = "Change it!"
ShHead(22) = "Reason"
'Creates header for sheets "NoResult", "Result"
For i = 1 To 19
    If i = 1 Then
        ShHead2(i) = ShHead(i)
    Else
        ShHead2(i) = ShHead(i + 3)
    End If
Next
'Loops all sheets in workbook and removes filters, if they exist before data are processed
For Each Sh In ThisWorkbook.Worksheets
    If Sh.AutoFilterMode = True Then
        Sh.AutoFilterMode = False
    End If
Next Sh
'Formating sheet "Result"
With ThisWorkbook.Sheets("Result")
    'Clears whole sheet
    .UsedRange.Clear
    'Text in first row set to bold
    .Range("A4:S4").Font.Bold = True
    'Creates filter
    .Range("A4:S4").AutoFilter
    'Writes headers
    .Range("A4:S4").Value2 = ShHead2
    'Sets width of columns for differnet columns
    .Columns("A").ColumnWidth = 10
    .Columns("B").ColumnWidth = 25
    .Columns("C").ColumnWidth = 30
    .Columns("D:E").ColumnWidth = 4
    .Columns("F").ColumnWidth = 10
    .Columns("G:I").ColumnWidth = 2
    .Columns("J").ColumnWidth = 8
    .Columns("K").ColumnWidth = 5.5
    .Columns("L").ColumnWidth = 35
    .Columns("M").ColumnWidth = 3
    .Columns("N:O").ColumnWidth = 6
    .Columns("P").ColumnWidth = 20
    .Columns("Q").ColumnWidth = 20
    .Columns("R").ColumnWidth = 5
    .Columns("S").ColumnWidth = 40
    'Wraps text in column
    .Columns("L").WrapText = True
    .Columns("S").WrapText = True
    'Sets formats for columns containing numbers
    .Columns("A").NumberFormat = "@"
    .Columns("D:E").NumberFormat = "@"
    .Columns("F").NumberFormat = "m/d/yyyy"
    .Columns("J").NumberFormat = "### ### ###"
    .Range("G:G").HorizontalAlignment = xlCenter
    .Range("Q:Q").HorizontalAlignment = xlLeft
    'Sets height for all rows
    .Rows("1:1048576").RowHeight = 15
End With
'Goes to sheet and cell
Application.Goto ThisWorkbook.Sheets("Result").Range("A5")
'Freezes panes
ActiveWindow.FreezePanes = False
'Freezes panes
ActiveWindow.FreezePanes = True
Application.StatusBar = "Sheet /Result/ formated!"
'Formating sheet "NoResult"
With ThisWorkbook.Sheets("NoResult")
    'Clears whole sheet
    .UsedRange.Clear
    'Text in first row set to bold
    .Range("A4:S4").Font.Bold = True
    'Creates filter
    .Range("A4:S4").AutoFilter
    'Writes headers
    .Range("A4:S4").Value = ShHead2
    'Sets width of columns for differnet columns
    .Columns("A").ColumnWidth = 10
    .Columns("B").ColumnWidth = 25
    .Columns("C").ColumnWidth = 30
    .Columns("D:E").ColumnWidth = 4
    .Columns("F").ColumnWidth = 10
    .Columns("G:I").ColumnWidth = 2
    .Columns("J").ColumnWidth = 8
    .Columns("K").ColumnWidth = 5.5
    .Columns("L").ColumnWidth = 35
    .Columns("M").ColumnWidth = 3
    .Columns("N:O").ColumnWidth = 6
    .Columns("P").ColumnWidth = 20
    .Columns("Q").ColumnWidth = 20
    .Columns("R").ColumnWidth = 5
    .Columns("S").ColumnWidth = 40
    'Wraps text in column
    .Columns("L").WrapText = True
    .Columns("S").WrapText = True
    'Sets formats for columns containing numbers
    .Columns("A").NumberFormat = "@"
    .Columns("D:E").NumberFormat = "@"
    .Columns("F").NumberFormat = "m/d/yyyy"
    .Columns("J").NumberFormat = "### ### ###"
    .Range("G:G").HorizontalAlignment = xlCenter
    .Range("Q:Q").HorizontalAlignment = xlLeft
    'Sets height for all rows
    .Rows("1:1048576").RowHeight = 15
End With
'Goes to sheet and cell
Application.Goto ThisWorkbook.Sheets("NoResult").Range("A5")
'Freezes panes
ActiveWindow.FreezePanes = False
'Freezes panes
ActiveWindow.FreezePanes = True
Application.StatusBar = "Sheet /NoResult/ formated!"
'====================
'Procedure that adds finishing touches at end of procedure
Call EndProcedure
'====================
End Sub
4

0 回答 0