Здравствуйте! Суть задачи такова: ячейка C2 может принимать значения от 1 до 5 с шагом 1, нужно найти такое значение, для которого результат в ячейке C3 будет наименьшим и при этом значение в ячейке C4 будет больше или равно 1,5. Нужно макросом перебрать все значения для C2 и найти оптимальное. Ячейки C3 и C4 зависят от ячейки C2 не в виде функции, а случайны так как начальные данные для расчета берутся из таблицы с разными значениями. По этому подбор оптимального значения с помощью надстройки Поиск решения может не дать оптимальный результат - нужно перебрать именно все значения. Заранее благодарю за помощь!
Здравствуйте! Суть задачи такова: ячейка C2 может принимать значения от 1 до 5 с шагом 1, нужно найти такое значение, для которого результат в ячейке C3 будет наименьшим и при этом значение в ячейке C4 будет больше или равно 1,5. Нужно макросом перебрать все значения для C2 и найти оптимальное. Ячейки C3 и C4 зависят от ячейки C2 не в виде функции, а случайны так как начальные данные для расчета берутся из таблицы с разными значениями. По этому подбор оптимального значения с помощью надстройки Поиск решения может не дать оптимальный результат - нужно перебрать именно все значения. Заранее благодарю за помощь!karachun_
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min, i, РешениеНайдено With Worksheets("Лист1") .Range("C2") = 1 Application.Calculate C3Min = .Range("C3") If .Range("C4") >= 1.5 Then _ РешениеНайдено = .Range("C2") For i = 2 To 5 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.5 Then If C3Min > .Range("C3") Then C3Min = .Range("C3") РешениеНайдено = i End If End If Next .Range("C2") = РешениеНайдено End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
[/vba]
Привет! [vba]
Код
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min, i, РешениеНайдено With Worksheets("Лист1") .Range("C2") = 1 Application.Calculate C3Min = .Range("C3") If .Range("C4") >= 1.5 Then _ РешениеНайдено = .Range("C2") For i = 2 To 5 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.5 Then If C3Min > .Range("C3") Then C3Min = .Range("C3") РешениеНайдено = i End If End If Next .Range("C2") = РешениеНайдено End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
Странно - при использовании этого макроса на реальной задаче в excel 2016 возникает ошибка: макрос подставляет пустое значение. Условия все похожи C2=1...155, C3=min, C4>=1,05. Код макроса: [vba]
Код
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min, i, РешениеНайдено With Worksheets("Check") .Range("C2") = 1 Application.Calculate C3Min = .Range("C3") If .Range("C4") >= 1.05 Then _ РешениеНайдено = .Range("C2") For i = 2 To 155 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.05 Then If C3Min > .Range("C3") Then C3Min = .Range("C3") РешениеНайдено = i End If End If Next .Range("C2") = РешениеНайдено End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
[/vba] В чем может быть проблема? Пробовал заменить кириллические символы латинскими - не помогло. Для значений C2>45 практически все варианты подходят.
Странно - при использовании этого макроса на реальной задаче в excel 2016 возникает ошибка: макрос подставляет пустое значение. Условия все похожи C2=1...155, C3=min, C4>=1,05. Код макроса: [vba]
Код
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min, i, РешениеНайдено With Worksheets("Check") .Range("C2") = 1 Application.Calculate C3Min = .Range("C3") If .Range("C4") >= 1.05 Then _ РешениеНайдено = .Range("C2") For i = 2 To 155 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.05 Then If C3Min > .Range("C3") Then C3Min = .Range("C3") РешениеНайдено = i End If End If Next .Range("C2") = РешениеНайдено End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
[/vba] В чем может быть проблема? Пробовал заменить кириллические символы латинскими - не помогло. Для значений C2>45 практически все варианты подходят.karachun_
это условие никогда не сможет быть выполнено так как в таблице по которой выбирается С3 наименьшее значение для С2=1 равно 2,31 Все остальные значения для С2>1 будут больше 2,31
Цитата
[vba]
Код
If C3Min > .Range("C3") Then
[/vba]
это условие никогда не сможет быть выполнено так как в таблице по которой выбирается С3 наименьшее значение для С2=1 равно 2,31 Все остальные значения для С2>1 будут больше 2,31alex77755
karachun_, всё-таки, по условиям Вашей задачи требуется проверять сначало условие, а потом искать минимум, поэтому придётся-таки подключить второй цикл: [vba]
Код
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min, i, РешениеНайдено Dim Condition1() As String, k As Long ReDim Condition1(2, 1) With Worksheets("Check") For i = 1 To 155 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.05 Then k = k + 1 ReDim Preserve Condition1(2, k) Condition1(1, k) = i Condition1(2, k) = .Range("C3") End If Next i For i = 1 To UBound(Condition1, 2) If i = 1 Then C3Min = Condition1(2, i) End If If C3Min > Condition1(2, i) Then C3Min = Condition1(2, i) РешениеНайдено = Condition1(1, i) End If Next i .Range("C2") = РешениеНайдено End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
[/vba]
karachun_, всё-таки, по условиям Вашей задачи требуется проверять сначало условие, а потом искать минимум, поэтому придётся-таки подключить второй цикл: [vba]
Код
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min, i, РешениеНайдено Dim Condition1() As String, k As Long ReDim Condition1(2, 1) With Worksheets("Check") For i = 1 To 155 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.05 Then k = k + 1 ReDim Preserve Condition1(2, k) Condition1(1, k) = i Condition1(2, k) = .Range("C3") End If Next i For i = 1 To UBound(Condition1, 2) If i = 1 Then C3Min = Condition1(2, i) End If If C3Min > Condition1(2, i) Then C3Min = Condition1(2, i) РешениеНайдено = Condition1(1, i) End If Next i .Range("C2") = РешениеНайдено End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
Спасибо за помощь. А если начать проверку с последнего значения - 155, а диапазон поиска 1-154: [vba]
Код
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min, i, РешениеНайдено With Worksheets("Check") .Range("C2") = 155 Application.Calculate C3Min = .Range("C3") If .Range("C4") >= 1.05 Then _ РешениеНайдено = .Range("C2") For i = 1 To 154 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.05 Then If C3Min > .Range("C3") Then C3Min = .Range("C3") РешениеНайдено = i End If End If Next .Range("C2") = РешениеНайдено End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
[/vba] На первый взгляд все работает, условие минимального значения в ячейке C3 теперь всегда выполняется - для данного примера последняя строка имеет самое большее значение. Пример в файле Check_v5. Макрос Roman777 ведет себя странно: в одних случаях возвращает последнее значение в таблице, в других - находит значение в середине списка, но оно не оптимально. Например при значении ячейки P4 (влияет на расчет значения С4) 5000 макрос выдает ответ 38, а при P4=50000 C2=155. Пример в файле Check_v4.
Спасибо за помощь. А если начать проверку с последнего значения - 155, а диапазон поиска 1-154: [vba]
Код
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min, i, РешениеНайдено With Worksheets("Check") .Range("C2") = 155 Application.Calculate C3Min = .Range("C3") If .Range("C4") >= 1.05 Then _ РешениеНайдено = .Range("C2") For i = 1 To 154 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.05 Then If C3Min > .Range("C3") Then C3Min = .Range("C3") РешениеНайдено = i End If End If Next .Range("C2") = РешениеНайдено End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
[/vba] На первый взгляд все работает, условие минимального значения в ячейке C3 теперь всегда выполняется - для данного примера последняя строка имеет самое большее значение. Пример в файле Check_v5. Макрос Roman777 ведет себя странно: в одних случаях возвращает последнее значение в таблице, в других - находит значение в середине списка, но оно не оптимально. Например при значении ячейки P4 (влияет на расчет значения С4) 5000 макрос выдает ответ 38, а при P4=50000 C2=155. Пример в файле Check_v4.karachun_
karachun_, Действительно, есть ошибка, нет явного приведения типов. И в строке [vba]
Код
If C3Min > Condition1(2, i) Then
[/vba] некорректно сравниваются значения типа variant со значениями типа string. Исправил макрос, убрал второй цикл, добавил явное приведение типов: [vba]
Код
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min As Double, i, РешениеНайдено Dim flg As Boolean, C3Cur As Double With Worksheets("Check") For i = 1 To 155 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.05 Then If Not flg Then РешениеНайдено = i C3Min = .Range("C3") flg = True Else C3Cur = CDbl(.Range("C3")) If C3Min > C3Cur Then C3Min = C3Cur РешениеНайдено = i End If End If End If Next i If flg Then .Range("C2") = РешениеНайдено Else MsgBox "Решение НЕ Найдено !!!" Exit Sub End If End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
[/vba]
karachun_, Действительно, есть ошибка, нет явного приведения типов. И в строке [vba]
Код
If C3Min > Condition1(2, i) Then
[/vba] некорректно сравниваются значения типа variant со значениями типа string. Исправил макрос, убрал второй цикл, добавил явное приведение типов: [vba]
Код
Option Explicit Sub ПоискРешения_InExSu() Dim C3Min As Double, i, РешениеНайдено Dim flg As Boolean, C3Cur As Double With Worksheets("Check") For i = 1 To 155 .Range("C2") = i Application.Calculate If .Range("C4") >= 1.05 Then If Not flg Then РешениеНайдено = i C3Min = .Range("C3") flg = True Else C3Cur = CDbl(.Range("C3")) If C3Min > C3Cur Then C3Min = C3Cur РешениеНайдено = i End If End If End If Next i If flg Then .Range("C2") = РешениеНайдено Else MsgBox "Решение НЕ Найдено !!!" Exit Sub End If End With MsgBox "РешениеНайдено = " & РешениеНайдено End Sub
Roman777, Привет помоги пожалуйста решить схожую задачу! VBA это будет или поиском решения я поиском решения сделал но на это время требуется более 1 часа ((((( вот ссылка на сайт где я уже прошу помощи. Там все объяснил надеюсь подробно... https://www.planetaexcel.ru/forum....1071282
Roman777, Привет помоги пожалуйста решить схожую задачу! VBA это будет или поиском решения я поиском решения сделал но на это время требуется более 1 часа ((((( вот ссылка на сайт где я уже прошу помощи. Там все объяснил надеюсь подробно... https://www.planetaexcel.ru/forum....1071282DarK_RenO
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Там все объяснил надеюсь подробно...
