Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
28.03.2024, 22:11:17

Войти
Добавляйтесь в нашу группу ВКонтакте - будьте в курсе всех новых событий сайта, узнавайте первым обо всех акциях и новых статьях!
33 233 Сообщений в 5 454 Тем от 6 750 Пользователей
Последний пользователь: Alex1210
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  Цикл для функции y=x*0.2+x
Страниц: 1 [2]  Все   Вниз
Печать
Автор Тема: Цикл для функции y=x*0.2+x  (Прочитано 8145 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 828



Просмотр профиля WWW
« Ответ #15 : 29.01.2019, 16:40:41 »

Еще лучше сделать так:
Код: (vb)
Sub test2()
    Dim i As Long, llastr As Long
    Dim d1 As Double, d2 As Double
    llastr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To llastr
        d1 = Cells(i, 1).Value
        d2 = d1 * 0.2 + d1
        Do While Round(Int(d2), 4) <> Round(d2, 4) ' Or Cells(i, 2).Value = ""
            d1 = d1 + 0.01
            d2 = d1 * 0.2 + d1
            If d2 > 100000 Then
                'принудительно завершаем цикл
                'если число уже вышло за рамки, а решение не найдено
                d2 = 0
                d1 = 0
                Exit Do
            End If
            DoEvents
        Loop
        'записываем конечное значение для второго столбца
        Cells(i, 2).Value = d2
        'записываем конечное значение для первого столбца(для проверки в третий)
        Cells(i, 3).Value = d1
    Next
End Sub

потому что
1. У числа d2 могут появляться "невидимые" хвосты в 15-значащем разряде после запятой, что приведет к ложному неравенству
2. Есть условие выхода из цикла при недостижении цели после определенного порогового значения. И такое тоже может быть. Тогда запишутся просто нули.
3. Этот код работать будет значительно быстрее
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Игорюша
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 11


Просмотр профиля
« Ответ #16 : 30.01.2019, 09:29:47 »

Ещё раз спасибо, за помощь)
Записывал значения в ячейку, что бы проверять их пошагово.

Вопрос по условию:
Код: (vb)
(Do While Round(Int(d2), 4) <> Round(d2, 4)

"Делать пока округлённое целое d2, неравно округлённому d2"
Оно так читается ?


Добавил немножко: d2 = Round(d2, 4)
А то получалось вот так:
Число 424.88(d1), по условию уже на 425(d1) должно выдать  ровно 510(d2).
получалось что оно проскакивает  до 2541.50(d2) и 2117.50(d1).
Хотя это может быть менее точное значение.

Сейчас вроде бы работает как нужно)
Код: (vb)
    Sub test3()
        Dim i As Long, llastr As Long
        Dim d1 As Double, d2 As Double
        llastr = Cells(Rows.Count, 1).End(xlUp).Row
        For i = 1 To llastr
            d1 = Cells(i, 1).Value
            d2 = d1 * 0.2 + d1
            d2 = Round(d2, 4) ' Добавил вот тут
            Do While Round(Int(d2), 4) <> Round(d2, 4) ' Or Cells(i, 2).Value = ""
                d1 = d1 + 0.01
                d2 = d1 * 0.2 + d1
                d2 = Round(d2, 4) ' И тут
                If d2 > 10000 Then
                  
                    d2 = 0
                    d1 = 0
                    Exit Do
                End If
                DoEvents
            Loop
            
            Cells(i, 2).Value = d2
            Cells(i, 3).Value = d1
        Next
    End Sub

« Последнее редактирование: 30.01.2019, 10:32:12 от Игорюша » Записан
Страниц: 1 [2]  Все   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru