Макрос округления массива (значений в заданном столбце)

Макрос предназначен для округления значений в заданном столбце массива, с заданной точностью и направлением округления

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

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _____         _       _   _             __     __
|_ _| ____ | | | | | | __ __ \ \ / /
| | |_ / | | | |_| | \ \ /\ / / \ \ / /
| | / / | |___ | _ | \ V V / \ V /
|_| /___| |_____| |_| |_| \_/\_/ \_/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.