Excel VBA: Код на округление значений

[Raven2009]

Добрый день.

Такой вопрос: в колонках AE, AH, AK и далее есть результаты просчетов с делением. В колонках AC, AF, AI и далее есть формулы, округляющие эти результаты до целого. При этом с условием, что если результат 0,02 - округляется до 1 (это расчет людей), если 1,5 - округляется до 2. То есть почти по стандарту математического округления. Возможно ли сделать код округления данных? Заметьте, что формула прописана намного вниз в таблице. Это потому что в файл все время подгружаются данные из удаленной базы access.

[вложение удалено администратором]

[Администратор]

Если не смотреть формулу в столбце AC, как вообще должно происходить округление? Просто формула сложная и тяжело понять, что в ней происходит, например, отнимается 50%.

[Raven2009]

Суть в том, что если значение больше 0 и меньше 50% от единицы, то округлять в большую сторону - до целой единицы. В остальном так: если дробная часть меньше 50% (например 1,4) - округлять в меньшую сторону, в остальных случаях (1,5 и выше) - в большую сторону

[Администратор]

А если ноль в столбце AE, то что?

[Raven2009]

То "пусто".

[Администратор]

Макрос

Sub Макрос1()

    Dim rngRight As Range, arr3(), arrRes()
    Dim lr As Long, r As Long, c As Long
   
   
    '1. Отключение монитора.
    Application.ScreenUpdating = False
   
    '2. Поиск последней строки по столбцу "AB".
    lr = Columns("AB").Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
       
    '3. Vba-именование фрагмента, в котором находятся данные правой таблицы.
    Set rngRight = Range("AC11:AZ" & lr)
   
    '4. Создание ячеек в массиве-результате.
    ReDim arrRes(1 To rngRight.Rows.Count, 1 To 1)
   
    '5.
    ' Цикл по столбцам правой таблицы.
    For c = 1 To rngRight.Columns.Count Step 3
   
        '1) Копирование данных из третьего столбца триады в массив (для ускорения кода).
        arr3() = rngRight.Columns(c + 2).Value
       
        '2)
        ' Цикл по строкам правой таблицы.
        For r = 1 To UBound(arrRes, 1) Step 1
            ' Округление числа из третьего столбца.
            If IsNumeric(arr3(r, 1)) = False Then
                arrRes(r, 1) = Empty
            ElseIf arr3(r, 1) = 0 Then
                arrRes(r, 1) = Empty
            ElseIf arr3(r, 1) = Empty Then
                arrRes(r, 1) = Empty
            Else
                If arr3(r, 1) < 1 Then
                    arrRes(r, 1) = 1
                Else
                    arrRes(r, 1) = --Format(arr3(r, 1), "0")
                End If
            End If
        Next r
       
        '3) Запись результата в правую таблицу в соответствующий столбец.
        rngRight.Columns(c).Value = arrRes()
       
    Next c
   
    '6. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub

[свернуть]

[Raven2009]

И снова вы на высоте. Огромное спасибо! Работает отлично!