Excel VBA Макросы: GOALSEEK для нескольких ячеек в диапазоне

[Dimon171]

Хочу заставить Goalseek работать в диапазоне. Как это сделать?
Вот примеры. Хотелось бы чтобы для каждой ячейки из столбца rng он путем подбора подставил значение в столбец multiply, чтобы итоговое произведение rng*muliply было равно столбцу goal.

Код

Sub Macros_2()

    With Application
          .MaxIterations = 10000
          .MaxChange = 0.05
     End With
     
     Dim rng As Range
     Dim cell As Range
     Set rng = ThisWorkbook.Worksheets("Sheet2").Range("C3:C412")
     Set multiply = ThisWorkbook.Worksheets("Sheet2").Range("d3:d412")
     Set RNG1 = ThisWorkbook.Worksheets("Sheet2").Range("E3:E412")
     Sheets("Sheet2").Select
     For Each cell In rng.Cells
     multiply.GoalSeek Goal:=RNG1.Cells, _
     ChangingCell:=rng.Cells
     Next
     
End Sub

[свернуть]

[Администратор]

Макрос

Sub Macro()
         
    Dim sh_res As Worksheet
    Dim formulas As Range, goals As Range, res As Range
    Dim lr As Long, i As Long
     
   
    ' Отключение монитора, чтобы ускорить макрос.
    Application.ScreenUpdating = False
   
    '1. Настройки для работы с 'подбор параметра'.
    Application.MaxIterations = 10000
    Application.MaxChange = 0.05
   
    '2. Присваиваем листу, с которым надо работать, имя 'sh_res'.
        ' Далее в коде будем обращаться к листу по этому имени.
    ' Здесь укажите нужный лист.
    Set sh_res = ActiveSheet
   
    '3. Присваиваем имена нужным фрагментам.
        ' Поиск последней строки, в которой есть данные.
        ' End не ищет в скрытых строках.
    lr = sh_res.Cells(sh_res.Rows.Count, "E").End(xlUp).Row
    Set formulas = sh_res.Range("D3:D" & lr)
    Set goals = sh_res.Range("E3:E" & lr)
    Set res = sh_res.Range("C3:C" & lr)
   
    '4. Работа 'подбор параметра'.
    For i = 1 To formulas.Cells.Count
        formulas(i).GoalSeek Goal:=goals(i).Value, _
            ChangingCell:=res(i)
    Next i
   
    ' Включение монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation
     
End Sub

[свернуть]