Question

我有运行的代码并按照命令按钮执行我想要的操作，但是在执行时，它运行速度非常慢。代码从一个工作表中获取数据，并将其插入/格式化为已转换为范围的两个单独表中的另一个工作表。我这样做是因为我需要使用某些数据自动更新两个不同的图形。我还是VBA编码的新手，并且无论是提示还是方法来摆脱不必要的代码，都可以获得任何方向或帮助以使代码运行得更快，因为它可能比它需要的时间更长。< / p>

Public Sub Button1_Click() ' Update Button

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim lastRowPart As Long
Dim lastRowCW As Long
Dim lastRowQty As Long
Dim lastRowQtyLeft As Long
Dim lastRowDescrip As Long
Dim i, j, k As Integer
Dim IO As Worksheet: Set IO = Sheets("Inventory Overview")
Dim TD As Worksheet: Set TD = Sheets("Trend Data")

'1. Copies and formats data

lastRowPart = IO.Cells(Rows.count, "F").End(xlUp).Row
lastRowDescrip = IO.Cells(Rows.count, "G").End(xlUp).Row
lastRowQtyLeft = IO.Cells(Rows.count, "O").End(xlUp).Row
lastRowQty = IO.Cells(Rows.count, "I").End(xlUp).Row
lastRowCW = IO.Cells(Rows.count, "L").End(xlUp).Row



TD.Cells.UnMerge ' reset***

j = 2
k = 2
For i = 2 To lastRowCW
    If IO.Cells(i, "L").Value = "Unknown" Then
        TD.Cells(j, "G").Value = IO.Cells(i, "L").Value
        TD.Cells(j, "H").Value = IO.Cells(i, "F").Value
        TD.Cells(j, "I").Value = IO.Cells(i, "I").Value
        TD.Cells(j, "J").Value = IO.Cells(i, "O").Value
        TD.Cells(j, "K").Value = IO.Cells(i, "G").Value
        j = j + 1
    Else
        TD.Cells(k, "A").Value = IO.Cells(i, "L").Value
        TD.Cells(k, "B").Value = IO.Cells(i, "F").Value
        TD.Cells(k, "C").Value = IO.Cells(i, "I").Value
        TD.Cells(k, "D").Value = IO.Cells(i, "O").Value
        TD.Cells(k, "E").Value = IO.Cells(i, "G").Value
        k = k + 1
    End If
Next

' Autofit
TD.range("B1:B" & lastRowPart).Columns.AutoFit
TD.range("E1:E" & lastRowDescrip).Columns.AutoFit
TD.range("H1:H" & lastRowPart).Columns.AutoFit
TD.range("K1:K" & lastRowDescrip).Columns.AutoFit

'2. Sort Cells
Dim LastRow As Long
LastRow = TD.Cells(Rows.count, 5).End(xlUp).Row

With TD.Sort  ' sorts data from A to Z
 .SetRange TD.range("A2:E" & LastRow)
 .Header = xlGuess
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
End With

'3. Merge CW Cells
' rngMerge = range for parts reworked/left with known CW
' URngMerge = range for parts reported with unknown CW

Dim rngMerge As range, URngMerge As range, cell As range, lastRowMerge As Long, ULastRowMerge As Long
lastRowMerge = TD.Cells(Rows.count, 1).End(xlUp).Row
ULastRowMerge = TD.Cells(Rows.count, 7).End(xlUp).Row
Set rngMerge = TD.range("A1:A" & lastRowMerge)
Set URngMerge = TD.range("G1:G" & ULastRowMerge)

MergeAgain:
For Each cell In rngMerge
    If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
        range(cell, cell.Offset(1, 0)).Merge
        GoTo MergeAgain
    End If
Next

MergeAgain2:
For Each cell In URngMerge
    If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
        range(cell, cell.Offset(1, 0)).Merge
        GoTo MergeAgain2
    End If
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

加速代码执行的方法 - VBA

0 个答案: