Модуль Excel VBA не обновляется во время работы - PullRequest
1 голос
/ 10 июня 2019

У меня есть 2 модуля, основной модуль обновляет другой модуль во время работы и запускает этот модуль при каждом обновлении.

Проблема в том, что другой модуль, кажется, не обновляется во время работы (он запускает самый первый модуль, так как все выходы соответствуют первому входу). Но после завершения запуска я проверил другой модуль, и он обновляется. Но вывод не соответствует этому обновленному модулю.

Я уже задавал вопрос, но не получил ответа. Функциональный модуль VBA не рассчитывает все выходные значения

Я нашел похожий вопрос, но в моем случае решение не сработало. модуль кода Excel VBA не обновляется во время выполнения

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 ]

2 голосов
/ 11 июня 2019

При назначении +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
0 голосов
/ 11 июня 2019

Этот пример основан на вашем объяснении вашей проблемы. Весьма вероятно, что это не прямое решение, но я надеюсь, что оно даст вам представление о том, как структурировать логику и код для создания конкретного решения вашей проблемы без генерации кода.

Я предлагаю рассмотреть этот пример и посмотреть, сможете ли вы применить его к своему проблемному пространству, а затем задать новые вопросы здесь, чтобы преодолеть другие проблемы, с которыми вы столкнетесь на этом пути.

Приведенный ниже код автоматически подстраивается под любое количество фиксированных элементов, шагов и проверочных элементов, чтобы создать двумерный массив возможных решений для изучения.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...