Note: The other languages of the website are Google-translated. Back to English

Как выделить жирным шрифтом все конкретные слова в диапазоне ячеек?

документ полужирный специальный текст 1

В 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 нажмите клавишу для запуска этого кода, и появится диалоговое окно, напоминающее вам о выборе диапазона данных, который вы хотите выделить полужирным шрифтом, см. снимок экрана:

документ полужирный специальный текст 2

4, Затем нажмите OK, появится еще одно поле, чтобы напомнить вам, что вы вводите конкретный текст, который вы хотите выделить только в ячейках, см. снимок экрана:

документ полужирный специальный текст 3

5. После ввода текста нажмите OK и весь указанный вами текст выделен жирным шрифтом в выбранном диапазоне, см. снимок экрана:

документ полужирный специальный текст 4


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (9)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
Можно ли изменить этот VBA, чтобы выделить несколько текстов жирным шрифтом, например «KTE», «KTO» и «KTW»?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Эрик,

Может быть, следующий код VBA может помочь вам выделить несколько определенных ячеек жирным шрифтом, пожалуйста, примените приведенный ниже код.
Подпрограмма FindAndBold()
Дим я пока
Dim xFind как строка
Dim xCell как диапазон
Dim xTxtRg как диапазон
Dim xCount As Long
Dim xLen как целое число
Dim xStart как целое число
Dim xRg как диапазон, xRgFind как диапазон
Dim xTxt как строка
Dim xArr() как строка
On Error Resume Next
Если ActiveWindow.RangeSelection.Count > 1 Тогда
xTxt = ActiveWindow.RangeSelection.AddressLocal
Еще
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Установите xRg = Application.InputBox («Пожалуйста, выберите диапазон данных:», «Kutools для Excel», xTxt, , , , , 8)
Если xRg ничего не значит, выйдите из Sub
On Error Resume Next
Установить xTxtRg = Application.Intersect(xRg.SpecialCells(xlCellTypeConstants, xlTextValues), xRg)
Если xTxtRg ничто, то
MsgBox "Нет ячеек с текстом"
Exit Sub
End If
Установите xRgFind = Application.InputBox («Выделите текстовые ячейки, которые вы хотите выделить жирным шрифтом», «Kutools for Excel», , , , , , 8)
Если xRgFind ничто, то
MsgBox «Текст не указан», vbInformation, «Kutools for Excel»
Exit Sub
End If
ReDim xArr (xRgFind.Count - 1)
Для I = 0 To (xRgFind.Count - 1)
xArr(I) = xRgFind(I + 1)
Далее
Для каждой ячейки xTxtRg
Для I = 0 To UBound(xArr)
xFind = Обрезать (xArr (I))
xStart = InStr(xCell.Value, xFind)
xLen = Len(xнайти)
Делать, пока xStart > 0
xCell.Characters(xStart, xLen).Font.Bold = True
xCount = xCount + 1
xStart = InStr(xStart + xLen, xCell.Value, xFind)
Петля
Далее
Далее
Если xCount > 0 Тогда
MsgBox "количество" & CStr(xCount) & "текст будет выделен жирным шрифтом!", vbInformation, "Kutools for Excel"
Еще
MsgBox «Не найти конкретный текст!», vbInformation, «Kutools for Excel»
End If
End Sub

Надеюсь, это поможет вам, спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
если я хочу сделать жирным строку G-AD только это не работает, если у меня в ячейке есть G-AD и G-AD-бла-бла-бла (эта G-AD не должна быть жирной)
Этот комментарий был сведен к минимуму модератором на сайте
Привет Skyyang, вы можете помочь мне в моем Excel?
Если вы найдете «1º» в ячейке с несколькими строками, выделите эту строку жирным шрифтом.
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, возможно выполнить поиск по нескольким текстам и выделить этот текст жирным шрифтом ПЛЮС эту ячейку. (У меня есть 1 ячейка с 5 строками, я хочу выделить строку жирным шрифтом, если найду «1º», если остальные, как «2º», «3º», «число + º», жирным шрифтом только число.)

Другая потребность:
Если найти «1º» жирным шрифтом, эта клеточная линия
Этот комментарий был сведен к минимуму модератором на сайте
Я попытался запустить этот код и только что получил ошибку..."Ошибка компиляции: неправильное количество аргументов или неверное назначение свойства". Ниже приведено изображение сообщения об ошибке и точки останова кода.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Шерри,
Я не вижу ваш скриншот, пожалуйста, загрузите его снова.
Спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Я получаю первое всплывающее окно, но затем не получаю второе всплывающее окно для ввода слова?
Этот комментарий был сведен к минимуму модератором на сайте
Потрясающие! Работал отлично!
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL