Sub change_font()
Dim t ' переменная для счетчика времени
Dim arr As Variant, lr As Long, i As Long, app

t = Timer ' пременная для определения времени работы макроса (запоминаем текущее время)

app = Application.Calculation

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Worksheets("Лист1") ' имя Лист1 поменять на нужное имя листа с исходной таблицей (для форматирования)
    lr = .Cells(.Rows.Count, 3).End(xlUp).Row ' определяем последнюю заполненную ячейку на листа в 3 столбце
    arr = .Range("C1:C" & lr) ' помещаем весь диапазон 3 столбца в массив
    For i = LBound(arr, 1) To UBound(arr, 1) ' цикл по строкам массива
        Call font_regex(.Name, arr(i, 1), i, 3) ' вызываем процедуру форматирования текста
    Next i
End With

Application.ScreenUpdating = True
Application.Calculation = app

Debug.Print "total: " & Timer - t ' выводим общее время выполения макроса
End Sub
Private Sub font_regex(shName As String, what, cnt As Long, col As Long)
' font_regex -- процедура красит цифры жирным шрифтом
' shName: имя листа ( в Вашем случае Лист1)
' what: ячейка для проверки ( в Вашем случае arr(i, 1))
' cnt: номер строки (в Вашем случае i)
' col: номер столбца ( в Вашем случае 3)
Dim i ' переменная , для цикла по совпадениям
    With CreateObject("VBScript.Regexp")
        .Global = True: .MultiLine = True: .Pattern = "\d+" ' используем глобальный и многострочный флаги
        If .test(what) Then ' если в ячейке содержатся цифры, то
            For Each i In .Execute(what) ' цикл по найденным совпадениям в ячейке
                ' i.firstindex + 1 ниже - это начальная позиция совпадения, а i.Length - длина совпавшего фрагмента
                Cells(cnt, col).Characters(i.firstindex + 1, i.Length).Font.Bold = True ' устанавливаем шрифт в жирный
            Next i
        End If
    End With
End Sub

i.Length+1

i.Length