Добрый день.
Такой вопрос: в колонках AE, AH, AK и далее есть результаты просчетов с делением. В колонках AC, AF, AI и далее есть формулы, округляющие эти результаты до целого. При этом с условием, что если результат 0,02 - округляется до 1 (это расчет людей), если 1,5 - округляется до 2. То есть почти по стандарту математического округления. Возможно ли сделать код округления данных? Заметьте, что формула прописана намного вниз в таблице. Это потому что в файл все время подгружаются данные из удаленной базы access.
[вложение удалено администратором]
Если не смотреть формулу в столбце AC, как вообще должно происходить округление? Просто формула сложная и тяжело понять, что в ней происходит, например, отнимается 50%.
Суть в том, что если значение больше 0 и меньше 50% от единицы, то округлять в большую сторону - до целой единицы. В остальном так: если дробная часть меньше 50% (например 1,4) - округлять в меньшую сторону, в остальных случаях (1,5 и выше) - в большую сторону
А если ноль в столбце AE, то что?
То "пусто".
Макрос
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
И снова вы на высоте. Огромное спасибо! Работает отлично!