首页
学习
活动
专区
工具
TVP
发布
社区首页 >问答首页 >Excel VBA模块在运行时未更新

Excel VBA模块在运行时未更新
EN

Stack Overflow用户
提问于 2019-06-11 03:46:19
回答 2查看 344关注 0票数 1

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

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

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

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

代码语言:javascript
复制
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。

这些都是用来说明问题的例子。

EN

回答 2

Stack Overflow用户

回答已采纳

发布于 2019-06-11 05:10:18

虽然给动态编写代码的风险加了+1,但更改方法名称似乎会强制重新编译:

代码语言:javascript
复制
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
票数 2
EN

Stack Overflow用户

发布于 2019-06-11 22:00:23

这个例子是基于你对问题的解释。它很可能不是一个直接的解决方案,但我希望它能给你一个想法,如何组织你的逻辑和代码,以便在不生成代码的情况下为你的问题设计一个特定的解决方案。

我的建议是回顾这个例子,看看你是否可以将它应用于你的问题空间,然后在这里提出新的问题,以克服你在这个过程中遇到的其他问题。

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

代码语言:javascript
复制
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
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/56532672

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档