重构嵌套的“If”语句
以下是一些代码，它循环显示电子表格中的一个区域，并根据源单元格不包含值“（空白）”的条件执行代码。 这段代码可以工作，但是它以这种方式运行嵌套if语句的效率非常低。 从长远来看，我试图让它更有效率，但是我没有想法。
有什么build议么？
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 variables声明和赋值中有许多漏洞无法正确转录为变体数组方法，但这可能会有所帮助。
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秒内运行。 结果是一样的。
您是否已经尝试在循环之前将计算模式切换为手动，然后在循环之后将其切换回去？ 你所描述的就像WS3每个变化都有很多计算要刷新一样。 同时closuresScreenUpdating可能会有所帮助。
所以，这样的事情：
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的内容之前循环填写的细节，使无关的数据。
编辑（可能的解决scheme）
根据你的代码试图实现什么，你可以使用VBA来为相关单元赋值公式 – 没有循环！
假设WS3中的第2行有一个标题，则列B，C，D的结果公式R1C1为：
=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>'放到conststring中。 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