mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

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

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

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
 
    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)
        ReDim rarr(st_block& To end_block&)        ' формируем массив размером не более 65 тыс элементов
        For i = st_block& To end_block&: rarr(i) = 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): Next i
    Next st_block&
End Sub

Комментарии

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

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

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

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