Excel VBA模块在运行时未更新

时间:2019-06-10 19:46:18

标签: excel vba module

我有2个模块,主模块在运行时会更新另一个模块,并且每次更新时都会运行该模块。

问题在于,另一个模块在运行时似乎没有更新(它运行第一个模块,因为输出均根据第一个输入)。但是运行完成后,我检查了另一个模块并进行了更新。但是输出不符合该更新的模块。

我已经问过这个问题,但没有得到答案。 VBA Function Module Not Calculating All Output Values

我发现了一个类似的问题,但该解决方案不适用于我的情况。 excel vba code module not updated during run

Option Explicit

Public Sub AddNewWorkBookTEST()

Dim nextline As Long, LastUsedRowList As Long
Dim CodeString As String

Dim x As Long
Dim KWATT As Double


Dim folderPath As String
folderPath = Application.ActiveWorkbook.Path

LastUsedRowList = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row

For x = 1 To LastUsedRowList
    KWATT = Sheet4.Cells(x, 1)
    CodeString = CodeStringGenerator(KWATT)

    ''Update the module code
    With ActiveWorkbook.VBProject.VBComponents("MyNewTest").CodeModule
        .DeleteLines 1, .CountOfLines
    End With

    With ActiveWorkbook.VBProject.VBComponents("MyNewTest").CodeModule
        nextline = .CountOfLines + 1
        .InsertLines nextline, CodeString
    End With

CallOtherModule x
''Calling the function in the second module (where the code was copied).
'''Cannot call the function directly from this sub, since excel will 
''''crash:Call MyNewTest.SortedArray(x)

Next x


End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub CallOtherModule(ItemsCounter As Long)
    Call MyNewTest.SortedArray(ItemsCounter)
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''The function that writes the code of the second module as String
Function CodeStringGenerator(KWATT As Double) As String

CodeStringGenerator = "'Option Explicit" & vbCrLf & "Public Function 
SortedArray(ItemsCounter As Long) As Variant()" & vbCrLf & vbCrLf _
& "Dim TempSortedArray() As Variant" & vbCrLf _
& "Sheet4.Cells(ItemsCounter, 2) = " & KWATT + 5 & vbCrLf _
& "End Function" & vbCrLf

End Function

在第4页中,(输入,输出)(第一列,第二列)是:18、23; 20、23; 10、23; 9、23; 9,23; 10,23。

但是应该是18、23; 20、25; 10、15; 9、14; 9,14; 10,15。

这些只是显示问题的示例。

2 个答案:

答案 0 :(得分:2)

在为动态编写代码的风险赋予+1的同时,更改方法名称似乎会强制重新编译:

Public Sub AddNewWorkBookTEST()

    Dim nextline As Long, LastUsedRowList As Long
    Dim CodeString As String
    Dim x As Long
    Dim KWATT As Double


    Dim folderPath As String
    folderPath = Application.ActiveWorkbook.Path

    LastUsedRowList = sheet4.Cells(Rows.Count, 1).End(xlUp).Row

    For x = 1 To LastUsedRowList
        KWATT = sheet4.Cells(x, 1)
        Debug.Print KWATT
        CodeString = CodeStringGenerator(x, KWATT)
        ''Update the module code
        With ActiveWorkbook.VBProject.VBComponents("MyNewTest").CodeModule
            .DeleteLines 1, .CountOfLines
            nextline = .CountOfLines + 1
            .InsertLines nextline, CodeString
        End With
        Application.Run "MyNewTest.SortedArray_" & x, x
    Next x
End Sub


Function CodeStringGenerator(x As Long, KWATT As Double) As String
    CodeStringGenerator = "'Option Explicit" & vbCrLf & _
    "Public Function SortedArray_" & x & "(ItemsCounter As Long) As Variant()" & vbCrLf & vbCrLf _
    & "Dim TempSortedArray() As Variant" & vbCrLf _
    & "Sheet4.Cells(ItemsCounter, 2) = " & KWATT + 5 & vbCrLf _
    & "End Function" & vbCrLf
End Function

答案 1 :(得分:0)

此示例基于您对问题的解释。很有可能这不是直接的解决方案,但我希望它可以给您一个思路,如何构造逻辑和代码以针对您的问题制定具体的解决方案,而无需生成代码。

我的建议是查看此示例,看看是否可以将其应用于问题空间,然后在此处提出新问题以克服您在此过程中遇到的其他问题。

下面的代码会针对任意数量的固定元素,步骤和检查元素自动进行自我调整,以生成二维数组的可能解决方案以供检查。

Option Explicit

Public Sub Main()
    Dim fixedElements As Variant
    fixedElements = Array(0.5, 0.75, 1#, 2#, 3#, 4#)

    Dim solutions As Variant
    solutions = SolveForLoad(totalLoad:=20, numberOfSteps:=3, _
                             fixedElements:=fixedElements)

    Dim solutionsRows As Long
    Dim solutionsCols As Long
    solutionsRows = UBound(solutions, 1) - LBound(solutions, 1) + 1
    solutionsCols = UBound(solutions, 2) - LBound(solutions, 2) + 1

    Sheet1.UsedRange.Clear

    Dim solutionArea As Range
    Set solutionArea = Sheet1.Range("A1").Resize(solutionsRows, solutionsCols)
    solutionArea = solutions

    '--- sort the solutions now, calulating std deviation and range from load
End Sub

Private Function SolveForLoad(ByVal totalLoad As Long, _
                              ByVal numberOfSteps As Long, _
                              ByRef fixedElements As Variant) As Variant
    Dim checkElements As Variant
    checkElements = Array(3, 6, 9, 12, 15)

    '--- two-dimensional array that will hold all possible results
    Dim results As Variant
    ReDim results(LBound(fixedElements) To UBound(fixedElements), _
                  LBound(checkElements) To UBound(checkElements))

    Dim i As Long
    Dim j As Long
    Dim checkResult As Double
    For i = LBound(fixedElements) To UBound(fixedElements)
        For j = LBound(checkElements) To UBound(checkElements)
            checkResult = numberOfSteps * (checkElements(j) * fixedElements(i))
            results(i, j) = checkResult
        Next j
    Next i
    SolveForLoad = results
End Function