Форматирование множества чисел по образцу

Sub Egor1()
Dim c As Range, n&, s$
For Each c In Intersect(Selection, ActiveSheet.UsedRange).Rows(1).Cells
  s = Trim$(c)
  n = InStrRev(s, ",")
  If n Then s = "0." & String$(Len(s) - n, "0") Else s = "0"
  c.EntireColumn.NumberFormat = s
Next
End Sub

Sub расчет()
For i = 1 To 200
If Cells(2, i + 8) = "" Then
    Exit For
Else
    For j = 1 To 100000
        If Cells(j + 6, 7) = "" Then
            Exit For
        Else
            If Cells(5, i + 8) = "" Then
                Cells(j + 6, i + 8) = Cells(j + 6, i + 8)
            Else
                If Cells(j + 6, i + 8).Value < Cells(6, i + 8).Value Then
                    Cells(j + 6, i + 8) = Cells(5, i + 8)
                End If
            End If
        End If
    Next j
End If
Next i
End Sub

Sub FastNumberProcessor()
    Dim rng As Range, arr() As Variant, i As Long, j As Long
    Set rng = Application.InputBox("Выделите непустую ячейку внутри таблицы.", Title:="Выбор данных для обработки", Type:=8)
    Set rng = rng.CurrentRegion
    arr = rng
    For j = 1 To UBound(arr, 2)
        If arr(1, j) <> "" Then
            For i = 3 To UBound(arr)
                If arr(i, j) < arr(2, j) Then arr(i, j) = arr(1, j)
            Next i
        End If
    Next j
    rng = arr
End Sub

Sub FastNumberProcessor()
Dim rng As Range, arr() As Variant, i As Long, j As Long
Set rng = Range(Cells(5, 9), Cells(31, 17))
arr = rng
For j = 1 To UBound(arr, 2)
    If arr(1, j) <> "" Then
        For i = 3 To UBound(arr)
            If arr(i, j) < arr(2, j) Then arr(i, j) = arr(1, j)
        Next i
    End If
Next j
rng = arr
End Sub

Set rng = Application.InputBox("Выделите непустую ячейку внутри таблицы.", Title:="Выбор данных для обработки", Type:=8)

Set rng = Application.InputBox("Выделите всю таблицу.", Title:="Выбор данных для обработки", Type:=8)

Set rng = rng.CurrentRegion