Добрый день! Может и не самый быстрый вариант (на регулярных выражениях). У меня, на моем старом компьютере 5000 строк обрабатывает за 30-40 секунд. Код: [vba]
Код
Sub change_font() Dim t ' переменная для счетчика времени Dim arr As Variant, lr As Long, i As Long, app
t = Timer ' пременная для определения времени работы макроса (запоминаем текущее время)
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
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
[/vba]
Добрый день! Может и не самый быстрый вариант (на регулярных выражениях). У меня, на моем старом компьютере 5000 строк обрабатывает за 30-40 секунд. Код: [vba]
Код
Sub change_font() Dim t ' переменная для счетчика времени Dim arr As Variant, lr As Long, i As Long, app
t = Timer ' пременная для определения времени работы макроса (запоминаем текущее время)
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
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
Xpert, я отредактировал сообщение выше и обновил файл. Добавил комментарии в коде. Также нашел ошибку, из за которой неправильно считалась длина символьной последовательности совпадения: [vba]
Код
i.Length+1
[/vba]заменил на: [vba]
Код
i.Length
[/vba]
Xpert, я отредактировал сообщение выше и обновил файл. Добавил комментарии в коде. Также нашел ошибку, из за которой неправильно считалась длина символьной последовательности совпадения: [vba]