时间戳

首页 > 解决方案 > 提高循环内 if else 条件的性能

excel - 提高循环内 if else 条件的性能

问题描述

我写了一个 VBA 宏，我想提高性能，因为宏需要很长时间才能运行。

我认为运行性能受

For Each rCell In .Range("O3:O" & Range("O" & Rows.Count).End(xlUp).Row)它打算将循环限制到第一个空行。

Sub E_Product_Density_Check()

Dim ws As Worksheet

Set Vws = ThisWorkbook.Sheets("Variables")

Sheets("Sheet1").Select

Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Variables" Then

 Application.DecimalSeparator = ","

ws.Activate

With ActiveSheet
        For Each rCell In .Range("O3:O" & Range("O" & Rows.Count).End(xlUp).Row)
        For Each iCell In .Range("N3:N" & Range("N" & Rows.Count).End(xlUp).Row)
        For Each xCell In .Range("M3:M" & Range("M" & Rows.Count).End(xlUp).Row)
        For Each yCell In .Range("L3:L" & Range("L" & Rows.Count).End(xlUp).Row)

            If (rCell.Value / ((iCell.Value * xCell.Value * yCell.Value) / 1000000)) <= Application.WorksheetFunction.VLookup(ActiveSheet.Name, Vws.Range("A1:E10"), 5, False) Then
                rCell.Interior.Color = vbYellow
            Else
                rCell.Interior.Color = vbWhite
            End If
        Next yCell
        Next xCell
        Next iCell
        Next rCell
    End With
    End If
    Next ws
End Sub

标签： excelvba

解决方案

试试这个：

Sub E_Product_Density_Check2()
    Dim ws As Worksheet, Vws As Worksheet
    Set Vws = ThisWorkbook.Sheets("Variables")

    Sheets("Sheet1").Select
    ' Application.ScreenUpdating = False  (no need for this)
    Application.DecimalSeparator = ","

    Dim target As Variant
    Dim r_O As Range, r_N As Range, r_M As Range, r_L As Range
    Dim n As Long
    Dim i As Long

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Variables" Then
            ' For the target value for each worksheet
            target = Application.WorksheetFunction.VLookup(ws.Name, Vws.Range("A1:E10"), 5, False)
            ' ws.Activate  (this was slow)

            'Find the number of cells in column O, and assume the same number exists in N, M & L.
            n = ws.Range(ws.Range("O3"), ws.Range("O3").End(xlDown)).Rows.Count
            Set r_O = ws.Range("O3")
            Set r_N = ws.Range("N3")
            Set r_M = ws.Range("M3")
            Set r_L = ws.Range("L3")

            For i = 1 To n
            ' Go down the column O
                If (r_O.Cells(i, 1).Value / ((r_N.Cells(i, 1).Value * r_M.Cells(i, 1).Value * r_L.Cells(i, 1).Value) / 1000000)) < target Then
                    r_O.Cells(i, 1).Interior.Color = vbYellow
                Else
                    r_O.Cells(i, 1).Interior.Color = vbWhite
                End If
            Next i
        End If
    Next ws
End Sub

我认为您要做的是根据同一行中M、N 和 L 列的值设置 O 列的颜色。

我得出这个结论的原因是因为使用您的代码，O 列单元格的颜色仅由最后一行中的值决定， 因为内部循环的每次迭代都会覆盖同一个单元格。

推荐阅读