VBA 更改代码的编译是否会导致循环中的错误结果?

Is VBA compilation of changing code is responsible for wrong results in a loop?

在准备 SO post 的答案时发现以下代码仅适用于第一个循环。第一个循环的结果被结转,直到 last.To keep Question short details 被避免。可以参考上面链接的post。

尝试过 DoEvents、Wait、Sleep,甚至用 MsgBox 和断点停止代码,但都没有用。然而,在 post 中 posted 已经找到了解决方法。 是不是运行时缺少编译?那么为什么单循环的代码总是能正常工作呢?寻找对该主题的可能解释和/或理解。

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub test()
Dim TestStr As String
Dim CondStr As String, xFormula As String, iFormula As String
Dim Arr As Variant, VBstr As String
Dim i As Integer, Srw As Long, Lrw As Long, Rw As Long
Dim Ws As Worksheet

Set Ws = ThisWorkbook.ActiveSheet
Srw = 1
Lrw = Ws.Cells(Rows.Count, 1).End(xlUp).Row

For Rw = Srw To Lrw
TestStr = "AAA BBB DDD EEE GGG HHH A11 B11 C11 1A1 1AB AA0"
TestStr = "AAA BBB EEE GGG HHH A11 B11 C11 1A1 1AB AA0"
TestStr = Ws.Cells(Rw, 1).Value

CondStr = "( AAA + BBB + ( CCC | DDD ) + ( EEE + ! FFF ) ) | ( GGG + HHH + DDD + EEE + FFF )"
CondStr = Ws.Cells(Rw, 2).Value
'Debug.Print CondStr

Arr = Split(CondStr, " ")
VBstr = ""
    For i = LBound(Arr) To UBound(Arr)
    xFormula = Trim(Arr(i))
    Select Case xFormula
    Case ""
    iFormula = ""
    Case "(", ")"
    iFormula = Arr(i)
    Case "+"
    iFormula = " And "
    Case "|"
    iFormula = " OR "
    Case "!"
    iFormula = " Not "
    Case Else
    iFormula = (InStr(1, TestStr, xFormula) > 0)
    End Select
    VBstr = VBstr & iFormula
    Next i
VBstr = "VersatileCode=" & VBstr
Debug.Print Rw & VBstr

Dim StrLine As Long, LineCnt As Long
ThisWorkbook.VBProject.VBComponents("Module5").Activate
With ThisWorkbook.VBProject.VBComponents("Module5").CodeModule
StrLine = .ProcBodyLine("VersatileCode", vbext_pk_Proc)
LineCnt = .ProcCountLines("VersatileCode", vbext_pk_Proc)
.DeleteLines StrLine + 1, LineCnt - 2
.InsertLines StrLine + 1, VBstr
End With
'Sleep 200
DoEvents
DoEvents
Debug.Print VersatileCode()

    If VersatileCode() = True Then
    Ws.Cells(Rw, 4).Value = Ws.Cells(Rw, 3).Value
    Else
    Ws.Cells(Rw, 4).Value = 0
    End If
'MsgBox Rw & VBstr & vbCrLf & VersatileCode()
Next Rw
End Sub

带有 1-5 行循环的调试日志。第 3 行正确的结果将是 False 而 其他都是真的

1VersatileCode=(True And True And (False OR True) And (True And  Not False)) OR (True And True And True And True And False)
True
2VersatileCode=(False And True And (False OR True) And (True And  Not True)) OR (True And True And True And True And True)
True
3VersatileCode=(True And True And (False OR False) And (True And  Not False)) OR (True And True And False And True And False)
True
4VersatileCode=(True And True And (False OR True) And (True And  Not False)) OR (True And True And True And True And False)
True
5VersatileCode=(True And True And (False OR True) And (True And  Not False)) OR (True And True And True And True And False)
True

带有 3-5 行循环的调试日志。第 3 行正确的结果将是 False 而 其他都是真的

3VersatileCode=(True And True And (False OR False) And (True And  Not False)) OR (True And True And False And True And False)
False
4VersatileCode=(True And True And (False OR True) And (True And  Not False)) OR (True And True And True And True And False)
False
5VersatileCode=(True And True And (False OR True) And (True And  Not False)) OR (True And True And True And True And False)
False

动态代码用于重写模块中的单个函数,否则为空。为了强制编译,尝试重写整个函数和只更改过程主体行。但此方法仅适用于循环的第一次迭代,并在后续迭代中给出不正确的结果。

Function VersatileCode() As Boolean
VersatileCode = (True And True And (False Or True) And (True And Not False)) Or (True And True And True And True And False)
End Function

为了解决方法成功,我必须在新添加的工作簿和模块中将动态代码编写为过程,并将结果放入添加的工作簿中的一个单元格中。

代码外循环

Set Wb = Workbooks.Add
Set vbc = Wb.VBProject.VBComponents.Add(vbext_ct_StdModule)

''' 循环内的代码

Dim StrLine As Long, LineCnt As Long
With vbc.CodeModule
On Error Resume Next
StrLine = .ProcBodyLine("VersatileCode", vbext_pk_Proc)
LineCnt = .ProcCountLines("VersatileCode", vbext_pk_Proc)
.DeleteLines StrLine, LineCnt
On Error GoTo 0
.InsertLines StrLine + 1, "Sub VersatileCode()"
.InsertLines StrLine + 2, VBstr
.InsertLines StrLine + 3, "ThisWorkbook.Sheets(1).cells(1,1).value = X"
.InsertLines StrLine + 4, "End Sub"
End With
DoEvents
Application.Run Wb.Name & "!VersatileCode"
DoEvents

Rslt = Wb.Sheets(1).Cells(1, 1).Value

仍在寻找仅在当前工作簿模块中将动态代码用作函数而不涉及传递结果的任何单元格的可能性。

这是一个工作示例:

Sub test()

    Dim TestStr As String
    Dim CondStr As String, xFormula As String, iFormula As String
    Dim Arr As Variant, VBstr As String
    Dim i As Long

    TestStr = "AAA BBB DDD EEE GGG HHH A11 B11 C11 1A1 1AB AA0"

    CondStr = "( AAA + BBB + ( CCC | DDD ) + ( EEE + ! FFF ) ) | ( GGG + HHH + DDD + EEE + FFF )"

    Arr = Split(CondStr, " ")
    VBstr = ""
    For i = LBound(Arr) To UBound(Arr)
        xFormula = Trim(Arr(i))
        Select Case xFormula
        Case ""
            iFormula = ""
        Case "(", ")"
            iFormula = Arr(i)
        Case "+"
            iFormula = " And "
        Case "|"
            iFormula = " OR "
        Case "!"
            iFormula = " Not "
        Case Else
            iFormula = (InStr(1, TestStr, xFormula) > 0)
        End Select
        VBstr = VBstr & iFormula
    Next i

    Debug.Print EvaluateCode(VBstr)

End Sub

'evaluate VBA passed in as a string and return the result
Function EvaluateCode(VBstr As String)
    Const MOD_NAME As String = "Dynamic"
    Dim fn As String, theCode As String

    Randomize
    fn = "Temp_" & CLng(Rnd() * 1000)
    Debug.Print fn

    theCode = "Public Function " & fn & "()" & vbCrLf & _
              fn & " = " & VBstr & vbCrLf & _
              "End Function"

    With ThisWorkbook.VBProject.VBComponents(MOD_NAME).CodeModule
        If .CountOfLines > 0 Then .DeleteLines 1, .CountOfLines
        .InsertLines .CountOfLines + 1, theCode
    End With

    EvaluateCode = Application.Run(MOD_NAME & "." & fn)

End Function