Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск части текста с полужирным выделением - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск части текста с полужирным выделением (Макросы/Sub)
Поиск части текста с полужирным выделением
evgenyforever Дата: Воскресенье, 14.10.2018, 16:19 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Уважаемые коллеги, подскажите:

Получается так, что при запуске макроса, выделяется только одно слово, потом при повторном запуске макроса, снова выделяется только ОДНО слово.

Подскажите, как выделить полужирным НЕСКОЛЬКО слов сразу: "Ответы", "Вопросы", "Для того"

Заранее благодарен!

Сам код:

[vba]
Код
Option Compare Text
Sub Find_n_Highlight()
On Error Resume Next: Err.Clear
Dim ra As Range, cell As Range, res, txt$, v, pos&
res = InputBox("Введите текст, который необходимо подсветить в таблице", "Поиск и подсветка текста", "диз")
If VarType(res) = vbBoolean Then Exit Sub ' нажата кнопка ОТМЕНА
txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub ' текст не введен, или состоит из пробелов

Set ra = Range([A2], Range("DA" & Rows.Count).End(xlUp)) ' диапазон для поиска
Application.ScreenUpdating = False
ra.Font.Color = 0: ra.Font.Bold = 0 ' сброс цветового выделения

For Each cell In ra.Cells ' перебираем все ячейки
pos = 1
If cell.Text Like "*" & txt & "*" Then
arr = Split(cell.Text, txt, , vbTextCompare) ' разбивает текст ячейки на части
If UBound(arr) > 0 Then ' если подстрока найдена
For Each v In arr ' перебираем все вхождения
pos = pos + Len(v) ' начальная позиция
With cell.Characters(pos, Len(txt))

.Font.Bold = True ' и полужирным начертанием
End With
pos = pos + Len(txt)
Next v
End If
End If
Next cell
End Sub
[/vba]
К сообщению приложен файл: 10.xlsm(18.5 Kb)


Сообщение отредактировал evgenyforever - Понедельник, 15.10.2018, 11:48
 
Ответить
СообщениеУважаемые коллеги, подскажите:

Получается так, что при запуске макроса, выделяется только одно слово, потом при повторном запуске макроса, снова выделяется только ОДНО слово.

Подскажите, как выделить полужирным НЕСКОЛЬКО слов сразу: "Ответы", "Вопросы", "Для того"

Заранее благодарен!

Сам код:

[vba]
Код
Option Compare Text
Sub Find_n_Highlight()
On Error Resume Next: Err.Clear
Dim ra As Range, cell As Range, res, txt$, v, pos&
res = InputBox("Введите текст, который необходимо подсветить в таблице", "Поиск и подсветка текста", "диз")
If VarType(res) = vbBoolean Then Exit Sub ' нажата кнопка ОТМЕНА
txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub ' текст не введен, или состоит из пробелов

Set ra = Range([A2], Range("DA" & Rows.Count).End(xlUp)) ' диапазон для поиска
Application.ScreenUpdating = False
ra.Font.Color = 0: ra.Font.Bold = 0 ' сброс цветового выделения

For Each cell In ra.Cells ' перебираем все ячейки
pos = 1
If cell.Text Like "*" & txt & "*" Then
arr = Split(cell.Text, txt, , vbTextCompare) ' разбивает текст ячейки на части
If UBound(arr) > 0 Then ' если подстрока найдена
For Each v In arr ' перебираем все вхождения
pos = pos + Len(v) ' начальная позиция
With cell.Characters(pos, Len(txt))

.Font.Bold = True ' и полужирным начертанием
End With
pos = pos + Len(txt)
Next v
End If
End If
Next cell
End Sub
[/vba]

Автор - evgenyforever
Дата добавления - 14.10.2018 в 16:19
Pelena Дата: Воскресенье, 14.10.2018, 20:22 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 13220
Репутация: 2908 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
evgenyforever, оформите код тегами с помощью кнопки #, а не спойлером


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщениеevgenyforever, оформите код тегами с помощью кнопки #, а не спойлером

Автор - Pelena
Дата добавления - 14.10.2018 в 20:22
evgenyforever Дата: Воскресенье, 14.10.2018, 21:26 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, отредактировал
 
Ответить
СообщениеPelena, отредактировал

Автор - evgenyforever
Дата добавления - 14.10.2018 в 21:26
Pelena Дата: Воскресенье, 14.10.2018, 21:33 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 13220
Репутация: 2908 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Посмотрите, так хотели?
К сообщению приложен файл: 10-1-.xlsm(18.1 Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеПосмотрите, так хотели?

Автор - Pelena
Дата добавления - 14.10.2018 в 21:33
evgenyforever Дата: Воскресенье, 14.10.2018, 23:30 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо большое, только нужно оставить выделение полужирным во всём столбце (т. е. и в первой и во второй ячейках и по всему столбцу)


Сообщение отредактировал evgenyforever - Воскресенье, 14.10.2018, 23:43
 
Ответить
СообщениеСпасибо большое, только нужно оставить выделение полужирным во всём столбце (т. е. и в первой и во второй ячейках и по всему столбцу)

Автор - evgenyforever
Дата добавления - 14.10.2018 в 23:30
RAN Дата: Понедельник, 15.10.2018, 01:17 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4882
Репутация: 974 ±
Замечаний: 0% ±

2010
Только нужно правильно указать диапазон.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеТолько нужно правильно указать диапазон.

Автор - RAN
Дата добавления - 15.10.2018 в 01:17
evgenyforever Дата: Понедельник, 15.10.2018, 03:22 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Макрос не все заданные значения отрабатывает, необходимо так:

ФИО: Иванов Иван Иванович.
Контактный телефон: 1-1-1-1-1.
Клуб: улица и дом.
Время инцидента: последние время.
Благодарность: результативный
Имя и приметы: не указаны.

А получается так:

ФИО: Иванов Иван Иванович.
Контактный телефон: 1-1-1-1-1.
Клуб: улица и дом.
Время инцидента: последние время.
Благодарность: результативный
Имя и приметы: не указаны.

[vba]
Код
Option Compare Text

Sub Find_n_Highlight()
    On Error Resume Next: Err.Clear
    Dim ra As Range, cell As Range, res, txt$, v, pos&, arFind, f
    res = InputBox("Введите текст, который необходимо подсветить в таблице", "Поиск и подсветка текста", "ФИО:, контактный телефон:, клуб:, Время инцидента:, имя и приметы")
    If VarType(res) = vbBoolean Then Exit Sub    ' нажата кнопка ОТМЕНА
    txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub    ' текст не введен, или состоит из пробелов
    Application.ScreenUpdating = False
    Set ra = Range(["A1:A500"], Range("A" & Rows.Count).End(xlUp))    ' диапазон для поиска
    ra.Font.Color = 0: ra.Font.Bold = 0  ' сброс цветового выделения
    arFind = Split(txt, ",")
    For Each f In arFind
        For Each cell In ra    ' перебираем все ячейки
            pos = 1
            If cell.Text Like "*" & f & "*" Then
                arr = Split(cell.Text, f, , vbTextCompare)   ' разбивает текст ячейки на части
                If UBound(arr) > 0 Then    ' если подстрока найдена
                    For Each v In arr    ' перебираем все вхождения
                        pos = pos + Len(v)    ' начальная позиция
                        With cell.Characters(pos, Len(f))

                            .Font.Bold = True    ' и полужирным начертанием
                        End With
                        pos = pos + Len(f)
                    Next v
                End If
            End If
        Next cell
    Next f
End Sub
[/vba]


Сообщение отредактировал evgenyforever - Понедельник, 15.10.2018, 06:55
 
Ответить
СообщениеМакрос не все заданные значения отрабатывает, необходимо так:

ФИО: Иванов Иван Иванович.
Контактный телефон: 1-1-1-1-1.
Клуб: улица и дом.
Время инцидента: последние время.
Благодарность: результативный
Имя и приметы: не указаны.

А получается так:

ФИО: Иванов Иван Иванович.
Контактный телефон: 1-1-1-1-1.
Клуб: улица и дом.
Время инцидента: последние время.
Благодарность: результативный
Имя и приметы: не указаны.

[vba]
Код
Option Compare Text

Sub Find_n_Highlight()
    On Error Resume Next: Err.Clear
    Dim ra As Range, cell As Range, res, txt$, v, pos&, arFind, f
    res = InputBox("Введите текст, который необходимо подсветить в таблице", "Поиск и подсветка текста", "ФИО:, контактный телефон:, клуб:, Время инцидента:, имя и приметы")
    If VarType(res) = vbBoolean Then Exit Sub    ' нажата кнопка ОТМЕНА
    txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub    ' текст не введен, или состоит из пробелов
    Application.ScreenUpdating = False
    Set ra = Range(["A1:A500"], Range("A" & Rows.Count).End(xlUp))    ' диапазон для поиска
    ra.Font.Color = 0: ra.Font.Bold = 0  ' сброс цветового выделения
    arFind = Split(txt, ",")
    For Each f In arFind
        For Each cell In ra    ' перебираем все ячейки
            pos = 1
            If cell.Text Like "*" & f & "*" Then
                arr = Split(cell.Text, f, , vbTextCompare)   ' разбивает текст ячейки на части
                If UBound(arr) > 0 Then    ' если подстрока найдена
                    For Each v In arr    ' перебираем все вхождения
                        pos = pos + Len(v)    ' начальная позиция
                        With cell.Characters(pos, Len(f))

                            .Font.Bold = True    ' и полужирным начертанием
                        End With
                        pos = pos + Len(f)
                    Next v
                End If
            End If
        Next cell
    Next f
End Sub
[/vba]

Автор - evgenyforever
Дата добавления - 15.10.2018 в 03:22
Pelena Дата: Понедельник, 15.10.2018, 08:21 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 13220
Репутация: 2908 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Файл с примером приложите


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеФайл с примером приложите

Автор - Pelena
Дата добавления - 15.10.2018 в 08:21
evgenyforever Дата: Понедельник, 15.10.2018, 08:54 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, подкрепил
К сообщению приложен файл: 9750253.xlsm(20.8 Kb)
 
Ответить
СообщениеPelena, подкрепил

Автор - evgenyforever
Дата добавления - 15.10.2018 в 08:54
RAN Дата: Понедельник, 15.10.2018, 09:04 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4882
Репутация: 974 ±
Замечаний: 0% ±

2010
[vba]
Код
For Each f In arFind
    f = Trim(f)
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
For Each f In arFind
    f = Trim(f)
[/vba]

Автор - RAN
Дата добавления - 15.10.2018 в 09:04
evgenyforever Дата: Понедельник, 15.10.2018, 11:45 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
RAN,
Если всё же возможно, не могли бы Вы написать полноценный код, на основании Ваших правок.


Сообщение отредактировал evgenyforever - Понедельник, 15.10.2018, 11:45
 
Ответить
СообщениеRAN,
Если всё же возможно, не могли бы Вы написать полноценный код, на основании Ваших правок.

Автор - evgenyforever
Дата добавления - 15.10.2018 в 11:45
Pelena Дата: Понедельник, 15.10.2018, 11:49 | Сообщение № 12
Группа: Админы
Ранг: Местный житель
Сообщений: 13220
Репутация: 2908 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Я, правда, не RAN, но раз уж сделала, выложу
К сообщению приложен файл: 1298009.xlsm(21.4 Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЯ, правда, не RAN, но раз уж сделала, выложу

Автор - Pelena
Дата добавления - 15.10.2018 в 11:49
evgenyforever Дата: Понедельник, 15.10.2018, 11:59 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Ran Огромнейшее спасибо! Вы мне очень помогли! С меня благодарность чуть позже!


Сообщение отредактировал evgenyforever - Понедельник, 15.10.2018, 12:24
 
Ответить
СообщениеPelena, Ran Огромнейшее спасибо! Вы мне очень помогли! С меня благодарность чуть позже!

Автор - evgenyforever
Дата добавления - 15.10.2018 в 11:59
evgenyforever Дата: Вторник, 16.10.2018, 06:26 | Сообщение № 14
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Один момент остаётся не решённым, возможно Вы также подскажите, как скорректировать код, когда действуют правила условного форматирования - код не работает (т.е. он работает. но не происходят изменения)
К сообщению приложен файл: _____.xlsm(20.3 Kb)
 
Ответить
СообщениеОдин момент остаётся не решённым, возможно Вы также подскажите, как скорректировать код, когда действуют правила условного форматирования - код не работает (т.е. он работает. но не происходят изменения)

Автор - evgenyforever
Дата добавления - 16.10.2018 в 06:26
Pelena Дата: Вторник, 16.10.2018, 11:07 | Сообщение № 15
Группа: Админы
Ранг: Местный житель
Сообщений: 13220
Репутация: 2908 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Если всё равно макрос работает, делайте заливку тоже макросом.
Если не разберётесь, создавайте новую тему, т.к. этот вопрос уже к данной теме не относится


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЕсли всё равно макрос работает, делайте заливку тоже макросом.
Если не разберётесь, создавайте новую тему, т.к. этот вопрос уже к данной теме не относится

Автор - Pelena
Дата добавления - 16.10.2018 в 11:07
evgenyforever Дата: Вторник, 16.10.2018, 11:11 | Сообщение № 16
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, спасибо
 
Ответить
СообщениеPelena, спасибо

Автор - evgenyforever
Дата добавления - 16.10.2018 в 11:11
RAN Дата: Вторник, 16.10.2018, 11:17 | Сообщение № 17
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4882
Репутация: 974 ±
Замечаний: 0% ±

2010
Причем тут код, если УФ просто изменяет форматирование ячейки на свое?
А УФ, как и любая формула, форматировать часть ячейки не может.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеПричем тут код, если УФ просто изменяет форматирование ячейки на свое?
А УФ, как и любая формула, форматировать часть ячейки не может.

Автор - RAN
Дата добавления - 16.10.2018 в 11:17
evgenyforever Дата: Вторник, 16.10.2018, 14:20 | Сообщение № 18
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
RAN, Pelena, Код работает - это самое главное, но дело в том, что таблица с УФ может быть достаточно ёмкой и каждый день может быть до 100 таких строк (это некий отчёт, который ежедневно обновляется), поэтому каждый раз приходится выделять эти значения в ручную, это затягивает процесс.
УФ должно быть, того требуют стандарты. Есть ли всё же смысл в создании новой темы, реально ли написать такой код, чтобы он работал вместе с УФ?
 
Ответить
СообщениеRAN, Pelena, Код работает - это самое главное, но дело в том, что таблица с УФ может быть достаточно ёмкой и каждый день может быть до 100 таких строк (это некий отчёт, который ежедневно обновляется), поэтому каждый раз приходится выделять эти значения в ручную, это затягивает процесс.
УФ должно быть, того требуют стандарты. Есть ли всё же смысл в создании новой темы, реально ли написать такой код, чтобы он работал вместе с УФ?

Автор - evgenyforever
Дата добавления - 16.10.2018 в 14:20
RAN Дата: Вторник, 16.10.2018, 19:33 | Сообщение № 19
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4882
Репутация: 974 ±
Замечаний: 0% ±

2010
Вы читать не умеете? Или читаете только то, что хотите?
Я же вроде ясно написал, что макрос работает (хочь с УФ, хочь без УФ), а полученное форматирование убивается УФ.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеВы читать не умеете? Или читаете только то, что хотите?
Я же вроде ясно написал, что макрос работает (хочь с УФ, хочь без УФ), а полученное форматирование убивается УФ.

Автор - RAN
Дата добавления - 16.10.2018 в 19:33
evgenyforever Дата: Среда, 17.10.2018, 12:46 | Сообщение № 20
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Ок. Вопрос закрыт.


Сообщение отредактировал evgenyforever - Среда, 17.10.2018, 12:47
 
Ответить
СообщениеОк. Вопрос закрыт.

Автор - evgenyforever
Дата добавления - 17.10.2018 в 12:46
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск части текста с полужирным выделением (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!