VBA Excel Макросы: Как добавить в ячейки пробелы, чтобы получилось заданное количество символов в ячейках?

[RostykG]

Пробую сделать макрос, который должен проверять сколько символов в ячейке и должен добавлять "пробел", пока не будет определенного количества символов.

Макрос должен работать от активной ячейки до строки 100.
В столбцах должно быть столько символов: 15,15,15,8,15,5,5,17,5,5,34,3,35,70,20,2,35,70,17,12,2,9,2,1,140,105,20,2,140,50,11,9.

Как это сделать?

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

В самом верху модуля вставьте это: Option Base 1. Чтобы порядковый номер первого элемента массива "lens" был 1, а не ноль, чтобы было удобнее писать и читать код.

Макрос

Option Base 1

Sub макрос()
   
    Dim arr(), lens(), dif As Long
    Dim i As Long, j As Long
   
   
    ' Создание массива "lens" и запись в него чисел.
    lens() = Array(15, 15, 15, 8, 15, 5, 5, 17, 5, 5, 34, 3, 35, 70, 20, 2, 35, 70, 17, 12, 2, 9, 2, 1, 140, 105, 20, 2, 140, 50, 11, 9)
   
    ' Если курсор-рамка находится ниже строки 100, то ничего не делаем.
    If ActiveCell.Row > 100 Then
        MsgBox "Активная ячейка ниже строки 100.", vbExclamation
        Exit Sub
    End If
   
    ' Копирование данных из экселя в массив. С массивом макрос быстрее работает.
    arr() = ActiveCell.Resize(100 - ActiveCell.Row + 1, UBound(lens))
   
    ' Добавление пробелов.
    For j = 1 To UBound(arr, 2)
        For i = 1 To UBound(arr, 1)
            ' Расчёт, сколько символов не хватает.
            dif = lens(j) - Len(arr(i, j))
            If dif > 0 Then
                arr(i, j) = arr(i, j) & Space(dif)
            End If
        Next i
    Next j
   
    ' Вставка изменённых данных обратно на лист.
    ActiveCell.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr()
   
End Sub

[свернуть]

[RostykG]

Спасибо большое!