У меня есть макрос, который в настоящее время работает, но не на 100%, и мне было интересно, если кто-то может просмотреть его. Проблема в том, что когда число вводится в ячейку H24, макрос не выполняет вычисления, как остальные 4 ячейки.
Вот что должен делать макрос:
- Когда число вводится в следующие ячейки: 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