Как сделать все конкретные слова полужирными в заданном диапазоне ячеек?
В Excel функция Поиск и замена позволяет находить любой конкретный текст и применять к нему полужирное начертание или любое другое форматирование — но только ко всей ячейке целиком. А пробовали ли вы когда-нибудь сделать полужирным лишь отдельный фрагмент текста внутри ячейки, как показано на скриншоте ниже:
Сделать все конкретные слова полужирными в диапазоне ячеек с помощью кода VBA
Сделать все конкретные слова полужирными в диапазоне ячеек с помощью кода VBA
Приведённый ниже код VBA поможет вам выделить жирным шрифтом только определённый фрагмент текста в содержимом ячейки. Выполните следующие действия:
1. Удерживая нажатыми клавиши ALT + F11, откройте окно Microsoft Visual Basic для приложений.
2. Нажмите Вставка > Модуль и вставьте приведённый ниже код в окно Модуля.
Код VBA: Сделать полужирным определённый текст в диапазоне ячеек
Sub FindAndBold()
'Updateby Extendoffice 20160711
Dim xFind As String
Dim xCell As Range
Dim xTxtRg As Range
Dim xCount As Long
Dim xLen As Integer
Dim xStart As Integer
Dim xRg As Range
Dim xTxt As String
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("Please select data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
On Error Resume Next
Set xTxtRg = Application.Intersect(xRg.SpecialCells(xlCellTypeConstants, xlTextValues), xRg)
If xTxtRg Is Nothing Then
MsgBox "There are no cells with text"
Exit Sub
End If
xFind = Trim(Application.InputBox("What do you want to BOLD?", "Kutools for Excel", , , , , , 2))
If xFind = "" Then
MsgBox "No text was listed", vbInformation, "Kutools for Excel"
Exit Sub
End If
xLen = Len(xFind)
For Each xCell In xTxtRg
xStart = InStr(xCell.Value, xFind)
Do While xStart > 0
xCell.Characters(xStart, xLen).Font.Bold = True
xCount = xCount + 1
xStart = InStr(xStart + xLen, xCell.Value, xFind)
Loop
Next
If xCount > 0 Then
MsgBox "number of " & CStr(xCount) & " text be bolded!", vbInformation, "Kutools for Excel"
Else
MsgBox "Not find the specific text!", vbInformation, "Kutools for Excel"
End If
End Sub
3. Нажмите клавишу F5, чтобы запустить код. Появится диалоговое окно с запросом выбора диапазона данных, текст в котором вы хотите сделать полужирным (см. скриншот):
4. После этого нажмите кнопку ОК. Появится ещё одно окно с запросом ввести конкретный текст, который необходимо сделать полужирным только внутри ячеек (см. скриншот):
5. После ввода текста нажмите кнопку ОК, и весь указанный вами текст будет выделен полужирным в диалоговом окне «Выберите диапазон» (см. скриншот):
Лучшие инструменты повышения продуктивности в Office
Раскройте весь потенциал Excel с помощью Kutools для Excel и ощутите эффективность как никогда раньше.Kutools для Excel предлагает более 300 расширенных функций для повышения продуктивности и Экономия времени.Нажмите здесь, чтобы получить нужную Вам функцию…
Office Tab добавляет в Office вкладки и значительно упрощает Вашу работу
- Включите редактирование и чтение во вкладках в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна — вместо того чтобы использовать отдельные окна.
- Повышает вашу продуктивность на 50 % и экономит сотни кликов мышью каждый день!
Все надстройки Kutools — один установщик
Kutools for Office — набор надстроек для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro, идеально подходящий командам, работающим с разными приложениями Office.
- Единый комплект— надстройки для Excel, Word, Outlook и PowerPoint + Office Tab Pro
- Один установщик, одна лицензия— настройка занимает считанные минуты (готово для MSI)
- Лучше работать вместе— оптимизированная продуктивность во всех приложениях Office
- 30-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек