У меня есть макрос, который в настоящее время работает, но не на 100%, и мне было интересно, если кто-то может просмотреть его. Проблема в том, что когда число вводится в ячейку H24, макрос не выполняет вычисления, как остальные 4 ячейки.

Вот что должен делать макрос:

  1. Когда число вводится в следующие ячейки: D24, F24, H24, J24 и L24 и нажимается ввод, программа выполняет вычисление, а затем отправляет ответ в ячейку под ним. Например, для ячейки L24 (введено 7,77) ответ (1,55) будет размещен в ячейке L25. Всегда будут цифры в 1 или во всех 5 ячейках.

Любой вклад / комментарии будут оценены.

превосходное изображение

КОД, РАЗМЕЩЕННЫЙ ПОД СЛЕДУЮЩИМ:

VBAProject
Объекты Microsoft Excel
Лист1 (Данные)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("MyInputs")) Is Nothing Then Exit Sub
If Target = 0 Or Target = vbNullString Then Exit Sub
Dim cLet As String
    Target.Offset(1, 0).ClearContents
    If Target.Value > 0 Then
      cLet = Target.Offset(2, 0).Value
      Range("B23").Formula = "=A23+INDIRECT(""" & cLet & """&""24"")"
      Range("C23").Formula = "=A23/2*INDIRECT(""B""&INDIRECT(""" & cLet & """&""23""))"
      ' Run Solver
      Application.Run ("RunSolver")
      'Reset
      'Activecell = 0
    End If
End Sub

КОД, РАЗМЕЩЕННЫЙ ПОД СЛЕДУЮЩИМ:

Modules
Module1
Option Explicit

Sub Preparation()
Dim cLet As String

    ActiveCell.Offset(2, 0).ClearContents
    If ActiveCell.Value > 0 Then
      cLet = ActiveCell.Offset(1, 0).Value
      Range("B23").Formula = "=A23+INDIRECT(""" & cLet & """&""24"")"
      Range("C23").Formula = "=A23/2*INDIRECT(""B""&INDIRECT(""" & cLet & """&""23""))"
      ' Run Solver
      Application.Run ("RunSolver")
      'Reset
      'Activecell = 0
    End If
End Sub

Private Sub RunSolver()
  Dim iLng As Long
  Dim Result

  iLng = Range("A23").Value

  ' Reset
  Application.Run "Solver.xlam!SolverReset"

  ' Set up new analysis
  Application.Run "Solver.xlam!SolverOk", "$B$23", 2, "0", "$A$23"

  ' Add constraints
  Application.Run "Solver.xlam!SolverAdd", "$B$23", 2, "$C$23"

  ' run the analysis
  Result = Application.Run("Solver.xlam!SolverSolve", True)

  ' finish the analysis
  Application.Run "Solver.xlam!SolverFinish"

  ' save the model
  'Application.Run "Solver.xlam!SolverSave", "$R$2"
  'SolverSolve UserFinish:=False
  'SolverSave SaveArea:=Range("A33")

  ' report on success of analysis
  If Result <= 3 Then
    ' Result = 0, Solution found, optimality and constraints satisfied
    ' Result = 1, Converged, constraints satisfied
    ' Result = 2, Cannot improve, constraints satisfied
    ' Result = 3, Stopped at maximum iterations

    'Display Result
    Cells(25, ActiveCell.Column).Value = Range("A23").Value
    Range("A23").Value = iLng
    MsgBox "Solver found a solution", vbInformation, "SOLUTION FOUND ..."

  Else
    ' Result = 4, Solver did not converge
    ' Result = 5, No feasible solution
    Beep
    MsgBox "Solver was unable to find a solution.", vbExclamation, "SOLUTION NOT FOUND ..."
  End If

End Sub

0