yy=17,5*0,2+17,5if int(yy) = yy thenmsgbox "y равно целому: " & yyy = yyend if
Dim y As Double, yy As Double, x As DoubleDim lr As Longx = 17.47For lr = 0 To 300 'цикл от 0 до 300 x = x + lr / 100 'прибавляем 0,01 к последнему значению x. С каждым циклом оно будет увеличиваться yy = x * 0.2 + x If Int(yy) = yy Then ' Int - спец.функция, которая отбрасывает дробную часть числа, оставляя только целую MsgBox "y равно целому: " & yy y = yy Exit For 'выходим из цикла принудительно, т.к. задача выполнена End IfNext
Dim y As Double, yy As Double, x As Double Dim lr As Double lr = 0.01 x = Cells(i, 1) Do While Cells(i, 1) <> "" ' тут первый цикл, где идёт выполнение условия: If Cells(i, 3) = "Число" Then ' если в 3м столбце есть слово "Число", тогда начинается расчёт. Do While yy = Double(yy) ' тут не знаю, как написать делать пока не произойдёт что? Пока число при округлении до 2х знаков п.з. не даст только нули(при этом результат всё равно нужен именно с 4мя знаками п.з.) yy = Cells(i, 1) * 0.2 + Cells(i, 1) If Int(yy) = yy Then ' тут тоже не знал как ещё написать условие со своим "целым" числом, оставил как у вас было yy = Cells(i, 2) End if End If i = i + 1
If Round(yy,2) = yy Then
Sub test2()Dim i As Integer, a As Doublei = 1 Do While Cells(i, 1) <> "" Cells(i, 2) = Cells(i, 1) * 0.2 + Cells(i, 1) If Int(Cells(i, 2)) = Cells(i, 2) Then Else Cells(i, 1) = Cells(i, 1) + 0.01 ' Как вот на этом месте, совершить "прыжок" ' обратно к условию "If Int(Cells(i, 2)) = Cells(i, 2) Then" ? ' для того что бы опять произошла проверка. End If i = i + 1 Loop End Sub
Sub test2()Dim i As Integer, a As Doublei = 1 Do While Cells(i, 1) <> "" ' цикл, идёт по всем ячейкам до "пустых". Cells(i, 2) = Cells(i, 1) * 0.2 + Cells(i, 1) ' 1) На каждой ячейке сначала выполняется вычисление по формуле: y=x*0.2+x ' И записывается каждое полученное значение в соседнюю ячейку. If Int(Cells(i, 2)) = Cells(i, 2) Then ' 2) Выполняется проверка: Является ли полученное число во второй ячейке целым. 'Если да, то пропускаем и идём "на выход". Else Cells(i, 1) = Cells(i, 1) + 0.01 'Если нет, то прибавляем +0.01 к числу именно из 1й ячейки. ' а вот как "зациклить" условие я ещё не понял. End If i = i + 1 Loop End Sub
Sub test2()Dim i As Integer, a As Doublei = 1 Do While Cells(i, 1) <> "" Cells(i, 2) = Cells(i, 1) * 0.2 + Cells(i, 1)Line1: If Int(Cells(i, 2)) = Cells(i, 2) Then GoTo Line2 Else Cells(i, 1) = Cells(i, 1) + 0.01 Cells(i, 2) = Cells(i, 1) * 0.2 + Cells(i, 1) GoTo Line1Line2: End If i = i + 1 Loop End Sub
Sub test2()Dim i As Integeri = 1 Do While Cells(i, 1) <> "" Cells(i, 2) = Cells(i, 1) * 0.2 + Cells(i, 1) Do Until Int(Cells(i, 2)) = Cells(i, 2) Cells(i, 1) = Cells(i, 1) + 0.01 Cells(i, 2) = Cells(i, 1) * 0.2 + Cells(i, 1) Loop i = i + 1 Loop End Sub
Sub test2() Dim i As Long, llastr As Long llastr = Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю ячейку данных 'цикл от первой ячейки до конца данных For i = 1 To llastr Do While (Int(Cells(i, 2).Value) <> Cells(i, 2).Value) Or Cells(i, 2).Value = "" Cells(i, 1).Value = Cells(i, 1).Value + 0.01 Cells(i, 2).Value = Cells(i, 1).Value * 0.2 + Cells(i, 1).Value DoEvents Loop NextEnd Sub
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 NextEnd Sub
(Do While Round(Int(d2), 4) <> Round(d2, 4)
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