Хочу заставить 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