☰

为什么我的 Excel 宏运行这么慢？

tag-icon • tag-icon microsoft-excel vba macros
为什么我的 Excel 宏运行这么慢？

我的 Excel 中的 VBA 代码运行非常慢。我怎样才能让这个宏代码运行得更快？

Sub Test()
Dim i As Long

For i = 1 To Rows.Count
Statusupdate = Cells(i, 1).Value

If Status = "Started" And IsEmpty(Cells(i, 11).Value) = True Then
Cells(i, 11).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Finished team A" And IsEmpty(Cells(i, 12).Value) = True Then
Cells(i, 12).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Started team B" And IsEmpty(Cells(i, 13).Value) = True Then
Cells(i, 13).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Finished team b" And IsEmpty(Cells(i, 14).Value) = True Then
Cells(i, 14).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Review" And IsEmpty(Cells(i, 15).Value) = True Then
Cells(i, 15).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Review finished" And IsEmpty(Cells(i, 16).Value) = True Then
Cells(i, 16).Value = Format(Now, "dd-mm-yy HH:mm")

ElseIf Status = "Finished" Then
Cells(i, 17).Value = Format(Now, "dd-mm-yy HH:mm")

End If
Next i
Application.ScreenUpdating = False
End Sub

答案1

您可以仅循环遍历具有值的行，而不是循环遍历工作表的所有 1,048,576 行。

'change
For i = 1 To Rows.Count
'to
For i = 1 to cells(rows.count, "A").end(xlup).row

您不必循环遍历工作表中的单元格，而是可以将 A 列中的值收集到一个数组中，并将日期值存储到另一个数组中，该数组将一次性存入工作表。

Option Explicit

Sub Test()
    Dim i As Long, arrA As Variant, arrKQ As Variant

    With Worksheets("sheet1")

        arrA = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Value2
        arrKQ = .Cells(1, "K").Resize(UBound(arrA, 1), 7).Value2

        For i = LBound(arrA, 1) To UBound(arrA, 1)

            Select Case LCase(arrA(i, 1))
                Case "started"
                    If IsEmpty(arrKQ(i, 1)) Then arrKQ(i, 1) = Now
                Case "finished team a"
                    If IsEmpty(arrKQ(i, 2)) Then arrKQ(i, 2) = Now
                Case "started team b"
                    If IsEmpty(arrKQ(i, 3)) Then arrKQ(i, 3) = Now
                Case "finished team b"
                    If IsEmpty(arrKQ(i, 4)) Then arrKQ(i, 4) = Now
                Case "review"
                    If IsEmpty(arrKQ(i, 5)) Then arrKQ(i, 5) = Now
                Case "review finished"
                    If IsEmpty(arrKQ(i, 6)) Then arrKQ(i, 6) = Now
                Case "finished"
                    arrKQ(i, 7) = Now
                Case Else
                    'do nothing (placeholder for future options)
            End Select

        Next i

        With .Cells(1, "K").Resize(UBound(arrKQ, 1), UBound(arrKQ, 2))

            .Value2 = arrKQ
            .NumberFormat = "dd-mm-yy hh:mm"

        End With

    End With

End Sub

相关内容