Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перебор значений макросом и нахождение лучшего варианта - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перебор значений макросом и нахождение лучшего варианта (Иное/Other)
Перебор значений макросом и нахождение лучшего варианта
karachun_ Дата: Пятница, 29.12.2017, 10:53 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте!
Суть задачи такова: ячейка C2 может принимать значения от 1 до 5 с шагом 1, нужно найти такое значение, для которого результат в ячейке C3 будет наименьшим и при этом значение в ячейке C4 будет больше или равно 1,5. Нужно макросом перебрать все значения для C2 и найти оптимальное. Ячейки C3 и C4 зависят от ячейки C2 не в виде функции, а случайны так как начальные данные для расчета берутся из таблицы с разными значениями. По этому подбор оптимального значения с помощью надстройки Поиск решения может не дать оптимальный результат - нужно перебрать именно все значения.
Заранее благодарю за помощь!
К сообщению приложен файл: 7629810.xls(38.5 Kb)
 
Ответить
СообщениеЗдравствуйте!
Суть задачи такова: ячейка C2 может принимать значения от 1 до 5 с шагом 1, нужно найти такое значение, для которого результат в ячейке C3 будет наименьшим и при этом значение в ячейке C4 будет больше или равно 1,5. Нужно макросом перебрать все значения для C2 и найти оптимальное. Ячейки C3 и C4 зависят от ячейки C2 не в виде функции, а случайны так как начальные данные для расчета берутся из таблицы с разными значениями. По этому подбор оптимального значения с помощью надстройки Поиск решения может не дать оптимальный результат - нужно перебрать именно все значения.
Заранее благодарю за помощь!

Автор - karachun_
Дата добавления - 29.12.2017 в 10:53
InExSu Дата: Пятница, 29.12.2017, 22:05 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 378
Репутация: 48 ±
Замечаний: 60% ±

Excel 2010
Привет!
[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
[/vba]


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839

Сообщение отредактировал InExSu - Пятница, 29.12.2017, 22:13
 
Ответить
СообщениеПривет!
[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
[/vba]

Автор - InExSu
Дата добавления - 29.12.2017 в 22:05
karachun_ Дата: Пятница, 29.12.2017, 23:27 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо, то что нужно!
 
Ответить
СообщениеСпасибо, то что нужно!

Автор - karachun_
Дата добавления - 29.12.2017 в 23:27
karachun_ Дата: Вторник, 02.01.2018, 17:09 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Странно - при использовании этого макроса на реальной задаче в 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 практически все варианты подходят.
К сообщению приложен файл: Check_v3.xlsm(63.2 Kb)
 
Ответить
СообщениеСтранно - при использовании этого макроса на реальной задаче в 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_
Дата добавления - 02.01.2018 в 17:09
alex77755 Дата: Вторник, 02.01.2018, 22:38 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 357
Репутация: 63 ±
Замечаний: 0% ±

Цитата
[vba]
Код
If C3Min > .Range("C3") Then
[/vba]

это условие никогда не сможет быть выполнено так как в таблице по которой выбирается С3 наименьшее значение для С2=1 равно 2,31
Все остальные значения для С2>1 будут больше 2,31


Могу помочь в VB6, VBA
Alex77755@mail.ru
 
Ответить
Сообщение
Цитата
[vba]
Код
If C3Min > .Range("C3") Then
[/vba]

это условие никогда не сможет быть выполнено так как в таблице по которой выбирается С3 наименьшее значение для С2=1 равно 2,31
Все остальные значения для С2>1 будут больше 2,31

Автор - alex77755
Дата добавления - 02.01.2018 в 22:38
Roman777 Дата: Вторник, 02.01.2018, 23:04 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 865
Репутация: 109 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
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
[/vba]

Автор - Roman777
Дата добавления - 02.01.2018 в 23:04
karachun_ Дата: Среда, 03.01.2018, 00:55 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо за помощь.
А если начать проверку с последнего значения - 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.
К сообщению приложен файл: Check_v4.xlsm(64.3 Kb) · Check_v5.xlsm(64.0 Kb)


Сообщение отредактировал karachun_ - Среда, 03.01.2018, 01:03
 
Ответить
СообщениеСпасибо за помощь.
А если начать проверку с последнего значения - 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_
Дата добавления - 03.01.2018 в 00:55
Roman777 Дата: Среда, 03.01.2018, 14:58 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 865
Репутация: 109 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
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
[/vba]

Автор - Roman777
Дата добавления - 03.01.2018 в 14:58
karachun_ Дата: Среда, 03.01.2018, 15:48 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Roman777 Спасибо, оба макроса выдают одинаковый результат, но Ваш подходит для таблицы с неупорядоченными данными.
 
Ответить
СообщениеRoman777 Спасибо, оба макроса выдают одинаковый результат, но Ваш подходит для таблицы с неупорядоченными данными.

Автор - karachun_
Дата добавления - 03.01.2018 в 15:48
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перебор значений макросом и нахождение лучшего варианта (Иное/Other)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!