Макрос по умножению рандомизированных чисел с данными в ячейках

Option Explicit
Option Base 1
Dim randel 'массив коэффициентов для процедуры yмножения колонки 1
 
 
Sub Wow_Grecha() ' создание массива разных чисел из интервала [a; b]
Const a = 0.94
Const b = 1.04
Dim krupa, bean, s As String, i As Long, k As Long
Set krupa = CreateObject("scripting.dictionary") ' словарь (объект VB)
On Error Resume Next
    Randomize
        For i = 1 To 20 'из прикидочного расчёта, что разных будет ~2500
            krupa.Add FormatNumber(a + (b - a) * Rnd, 5), i
        Next
On Error GoTo 0
ReDim randel(1)
        For Each bean In krupa
            k = k + 1
            ReDim Preserve randel(k)
            randel(k) = bean ' запись в массив randel элемента bean
        Next
        
    MsgBox "Количество коэффициентов в randel: " & UBound(randel)
    
    Moire ' эта процедура умножает числа колонки 1 на элементы randel
'    MsgBox Join(randel) ' показ первых случайных элементов массива
    Set krupa = Nothing  ' стёрли использованный словарь…
    Set randel = Nothing ' …и массив коэффициентов
'    Erase randel
End Sub
 
 
Sub Moire()
If Not IsArray(randel) Then MsgBox "Массив пуст.": Exit Sub
Dim cell, k As Long
    For Each cell In ActiveSheet.Columns(1).Cells  ' для клеток колонки 1
        If Not IsEmpty(Trim(cell)) Then ' при том, что эта клетка не пуста
            If IsNumeric(cell) Then
                k = k + 1
' ДЛЯ ОТЛАДКИ новые данные переписываются в соседний столбец, а ниже - в тот же
                cell.Offset(0, 1).Value = cell.Value * randel(k)
'                cell.Value = cell.Value * randel(k)
                If k = UBound(randel) Then Exit Sub ' коэффициенты кончились
            End If
        End If
    Next
End Sub