Question

这是一些代码，它循环遍历电子表格中的某个区域，并根据源单元格不包含值＆＃34;（空白）＆＃34;的条件执行代码。代码有效，但以这种方式运行嵌套的if语句效率很低。从长远来看，我一直试图提高效率，但我没有想法。

有什么建议吗？

Sub NestedIfStatement()
Dim lastrow1 As Long
Dim I As Integer, J As Integer, N As Integer, MaxPriority as Integer
Dim Maxnumber as Range
Dim WS1 As Worksheet, WS3 as Worksheet
Dim WB As Workbook

Set WB = ThisWorkbook
Set WS1 = WB.Worksheets("Config")
Set WS2 = WB.Worksheets("Data")
Set WS3 = WB.Worksheets("Status Report") 

lastrow1 = WS1.Cells(Rows.Count, 1).End(xlUp).Row
I = 1
J = 1    
N = 3
Set Maxnumber = WS1.Range("A" & I & ":A" & lastrow1)
    MaxPriority = Application.Max(Maxnumber)

For J = 1 To lastrow1
    If WS1.Cells(J, 1) <= MaxPriority Then
       If WS1.Cells(J, 6).Value <> "(blank)" Then
          WS3.Cells(N, 7).Value = WS1.Cells(J, 6).Value
       End If
       If WS1.Cells(J, 5).Value <> "(blank)" Then
          WS3.Cells(N, 6).Value = WS1.Cells(J, 5).Value
       End If
       If WS1.Cells(J, 4).Value <> "(blank)" Then
          WS3.Cells(N, 4).Value = WS1.Cells(J, 4).Value
       End If
       If WS1.Cells(J, 3).Value <> "(blank)" Then
          WS3.Cells(N, 3).Value = WS1.Cells(J, 3).Value
       End If
       If WS1.Cells(J, 2).Value <> "(blank)" Then
          WS3.Cells(N, 2).Value = WS1.Cells(J, 2).Value
       End If
       N = N + 1
    End If
Next J

End Sub

Answer 1

您是否尝试在循环之前将计算模式切换为手动，然后在循环后将其切换回来？您所描述的内容就像在WS3中的每次更改都要刷新很多计算。关闭ScreenUpdating可能会有所帮助。

所以，像这样：

Dim CalcMode As Long
'...
Application.ScreenUpdating = False
CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual ' Change it to manual update
For J = 1 To lastrow1
    '...
Next
Application.Calculation = CalcMode ' Restore to what it was before
Application.ScreenUpdating = True

或者，您可以将WS1中的值加载到Array（Variant）中，然后执行嵌套的If。

您可能遇到的另一个问题是，在循环填充详细信息之前，您没有清除WS3的内容，从而产生无关数据。

<小时/> 编辑（可能的解决方案）

根据您的代码尝试实现的内容，您可以使用VBA将Formula分配给关联的单元格 - 无循环！

假设WS3中的第2行有一个标题，则列B，C，D的结果 FormulaR1C1 为：
=IF(Config!R[-2]C<>"(blank)",Config!R[-2]C,"")
和列F， G是：=IF(Config!R[-2]C[-1]<>"(blank)",Config!R[-2]C[-1],"")

为了使公式更通用，我将'<S1>'放入const字符串中。 lastrow3基本上是WS3中需要这些公式的最后一行，它取决于WS1的A列中使用的行数。

请按时间差异并使用此代码回发，我们都对现实世界数据的效率感到好奇。

Option Explicit

Sub NestedIfStatement()
    Const Formula_FG = "=IF('<S1>'!R[-2]C[-1]<>""(blank)"",'<S1>'!R[-2]C[-1],"""")"
    Const Formula_BCD = "=IF('<S1>'!R[-2]C<>""(blank)"",'<S1>'!R[-2]C,"""")"

    Dim CalcMode As Long, sFormula As String
    Dim lastrow3 As Long
    Dim WS1 As Worksheet

    Application.ScreenUpdating = False
    CalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual

    With ThisWorkbook
        Set WS1 = .Worksheets("Config")
        lastrow3 = WS1.Cells(Rows.Count, 1).End(xlUp).Row + 2 ' Offset from row 1 to 3 (N)
        With .Worksheets("Status Report")
            .UsedRange.Offset(1, 0).ClearContents ' Remove old data below the header row
            sFormula = Replace(Formula_BCD, "<S1>", WS1.Name)
            .Range("B3:D" & lastrow3).FormulaR1C1 = sFormula
            sFormula = Replace(Formula_FG, "<S1>", WS1.Name)
            .Range("F3:G" & lastrow3).FormulaR1C1 = sFormula
        End With
        Set WS1 = Nothing
    End With

    Application.Calculation = CalcMode
    Application.ScreenUpdating = True

End Sub

Answer 2

您的变量声明和赋值中有许多漏洞无法正确转录为变量数组方法，但这可能会有所帮助。

Sub Nested_UnIf_Statement()
    Dim WS1 As Worksheet, WS3 As Worksheet, Maxnumber As Range
    Dim lastrow1 As Long, I As Long, N As Long, MaxPriority As Long
    Dim v As Long, vWS1s As Variant, vWS3BDs As Variant, vWS3FGs As Variant

    Debug.Print Timer
    Set WS1 = Worksheets("Sheet2")
    Set WS3 = Worksheets("Sheet3")

    I = 2
    With WS1
        lastrow1 = .Cells(Rows.Count, 1).End(xlUp).Row
        Set Maxnumber = .Range("A" & I & ":A" & lastrow1)
        MaxPriority = Application.Max(Maxnumber)
        vWS1s = WS1.Range("A" & I & ":F" & lastrow1).Value2
        ReDim vWS3BDs(1 To 3, 1 To 1)
        ReDim vWS3FGs(1 To 2, 1 To 1)
    End With

    For v = LBound(vWS1s, 1) To UBound(vWS1s, 1)
        If vWS1s(v, 1) <= MaxPriority Then
            vWS3BDs(1, UBound(vWS3BDs, 2)) = Replace(vWS1s(v, 2), "(blank)", "")
            vWS3BDs(2, UBound(vWS3BDs, 2)) = Replace(vWS1s(v, 3), "(blank)", "")
            vWS3BDs(3, UBound(vWS3BDs, 2)) = Replace(vWS1s(v, 4), "(blank)", "")
            vWS3FGs(1, UBound(vWS3FGs, 2)) = Replace(vWS1s(v, 5), "(blank)", "")
            vWS3FGs(2, UBound(vWS3FGs, 2)) = Replace(vWS1s(v, 6), "(blank)", "")
            ReDim Preserve vWS3BDs(LBound(vWS3BDs, 1) To UBound(vWS3BDs, 1), LBound(vWS3BDs, 2) To UBound(vWS3BDs, 2) + 1)
            ReDim Preserve vWS3FGs(LBound(vWS3FGs, 1) To UBound(vWS3FGs, 1), LBound(vWS3FGs, 2) To UBound(vWS3FGs, 2) + 1)
        End If
    Next v

    ReDim Preserve vWS3BDs(LBound(vWS3BDs, 1) To UBound(vWS3BDs, 1), LBound(vWS3BDs, 2) To UBound(vWS3BDs, 2) - 1)
    ReDim Preserve vWS3FGs(LBound(vWS3FGs, 1) To UBound(vWS3FGs, 1), LBound(vWS3FGs, 2) To UBound(vWS3FGs, 2) - 1)

    N = 3
    WS3.Cells(N, 2).Resize(UBound(vWS3BDs, 2), UBound(vWS3BDs, 1)) = _
       Application.Transpose(vWS3BDs)
    WS3.Cells(N, 2).Offset(0, UBound(vWS3BDs, 1) + 1).Resize(UBound(vWS3FGs, 2), UBound(vWS3FGs, 1)) = _
       Application.Transpose(vWS3FGs)

    Debug.Print Timer

End Sub

在5000行随机数据上，您的原始例程在00：00：01.10秒运行，而这一行在00：00：00.13秒运行。结果完全相同。

重构嵌套＆＃39;如果＆＃39;声明

2 个答案: