Макрос предназначен для округления значений в заданном столбце массива, с заданной точностью и направлением округления
Sub Пример_Округления_Массива() Dim arr As Variant ' считываем данные из диапазона ячеек в массив arr = Range("a2:c20").value ' переводим весь второй столбец в числа (на всякий случай) For i = LBound(arr) To UBound(arr) arr(i, 2) = Val(Replace(arr(i, 2), ",", ".")) Next i ' значения во втором столбце массива округляем до нуля знаков после запятой в бОльшую сторону RoundArray arr, 2, 0, 1 ' выводим результат на 4 столбца правее Range("a2:c20").offset(, 4).value = arr End Sub
Код функции округления:
Sub RoundArray(ByRef arr As Variant, ByVal Column&, ByVal DigitsAfterDecimal&, Optional ByVal RoundMode& = 0) ' производит округление всех значений в столбце Column& двумерного массива arr ' до заданного количества цифр после запятой DigitsAfterDecimal& ' RoundMode& - режим округления (0 - до ближайшего, 1 - в бОльшую сторону, 2 - в меньшую сторону) On Error Resume Next Const stp& = 65000 ' максимум столько чисел принимает функция листа ROUND одновременно Dim st_block&, end_block&, i&, rarr, shift& For st_block& = LBound(arr) To UBound(arr) Step stp& end_block& = st_block& + stp& - 1: If end_block& > UBound(arr) Then end_block& = UBound(arr) shift& = st_block& - 1 ReDim rarr(st_block& - shift& To end_block& - shift&) ' формируем массив размером не более 65 тыс элементов For i = st_block& To end_block&: rarr(i - shift&) = arr(i, Column&): Next i ' копируем в него данные ' потом округляем массив, и заносим результат обратно в исходный массив Select Case RoundMode& Case 0: rarr = Application.Round(rarr, DigitsAfterDecimal&) Case 1: rarr = Application.RoundUp(rarr, DigitsAfterDecimal&) Case 2: rarr = Application.RoundDown(rarr, DigitsAfterDecimal&) End Select ' округленные числа - обратно в исходный массив arr For i = st_block& To end_block&: arr(i, Column&) = rarr(i - shift&): Next i Next st_block& End Sub
Комментарии
Отправить комментарий