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

Вход

Регистрация

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

 

= Мир MS Excel/Выделение цветом несовпадающих слов после поиска - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Выделение цветом несовпадающих слов после поиска
Ikurudzz Дата: Понедельник, 06.05.2024, 21:03 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

2016
Здраствуйте! Прошу помочь решить такую задачку на выделение цветом слов внутри ячеек после поиска и отсутсвия таких слов в ячейках в столбце напротив.
В ячейке А1 - Ф И О(может быть Ф И О Ф И О)
В ячейке B1 - много текста, который содержит Ф И О(или текст и Ф И О Ф И О)
Если каждое слово из А1 есть в В1 - цветом не выделять, нет какого нибудь слова в В1 - отметить в А1 или "Ф" или "И" или "О" красным.
Пример результата:
А1: "Иванков Иван Иванович" B1: "Текст Иванов Иван Иванович текст"
А2: "Иванов Иван Петрович"   B2: "Текст Иванов Иван Иванович текст"
К сообщению приложен файл: 1974468.xlsx (8.8 Kb)


Сообщение отредактировал Ikurudzz - Понедельник, 06.05.2024, 21:05
 
Ответить
СообщениеЗдраствуйте! Прошу помочь решить такую задачку на выделение цветом слов внутри ячеек после поиска и отсутсвия таких слов в ячейках в столбце напротив.
В ячейке А1 - Ф И О(может быть Ф И О Ф И О)
В ячейке B1 - много текста, который содержит Ф И О(или текст и Ф И О Ф И О)
Если каждое слово из А1 есть в В1 - цветом не выделять, нет какого нибудь слова в В1 - отметить в А1 или "Ф" или "И" или "О" красным.
Пример результата:
А1: "Иванков Иван Иванович" B1: "Текст Иванов Иван Иванович текст"
А2: "Иванов Иван Петрович"   B2: "Текст Иванов Иван Иванович текст"

Автор - Ikurudzz
Дата добавления - 06.05.2024 в 21:03
Nic70y Дата: Вторник, 07.05.2024, 08:35 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 8988
Репутация: 2361 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub xu_18()
    Application.ScreenUpdating = False
    'нижняя* ячейка столбца A
    a = Cells(Rows.Count, "a").End(xlUp).Row
    'установим цвет шрифта = Авто
    Range("a1:a" & a).Font.ColorIndex = xlAutomatic
    'пройдемся циклом по ячейкам столбца A
    For b = 1 To a
        m = Range("a" & b).Value        'значение очередной ячейки
        n = Replace(m, Chr(160), " ")   'заменяем* неразрывные пробелы обычными
        c = n & " "                     'добавляем пробел в конец текста
        d = Len(c)                      'кол-во символов с пробелом в ячейке*
        e = Replace(c, " ", "")         'удалим* пробелы
        f = Len(e)                      'кол-во символов без пробелов
        g = d - f                       'кол-во пробелов = кол-во слов
        q = Range("b" & b).Value        'значение ячейки столбца B
        r = Replace(q, Chr(160), " ")   'заменяем* неразрывные пробелы обычными
        o = " " & r & " "               'добавим пробелы
        'пройдемся циклом по словам очередной ячейки
        i = 1 'начало слова
        For h = 1 To g
            l = Mid(c, i, d)        'текст без предыдущего слова
            j = InStr(l, " ")       'ищем очередной пробел
            k = " " & Mid(c, i, j)  'извлекаем* слово с пробелами
            p = InStr(o, k) 'ищем слово
            'если слово не найдено, выделяем
            If p = 0 Then
                Range("a" & b).Characters(Start:=i, Length:=j - 1).Font.Color = vbRed
            End If
            i = i + j 'начало очередного слова
        Next
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 1974468.xlsm (20.4 Kb)


ЮMoney 41001841029809
 
Ответить
Сообщение[vba]
Код
Sub xu_18()
    Application.ScreenUpdating = False
    'нижняя* ячейка столбца A
    a = Cells(Rows.Count, "a").End(xlUp).Row
    'установим цвет шрифта = Авто
    Range("a1:a" & a).Font.ColorIndex = xlAutomatic
    'пройдемся циклом по ячейкам столбца A
    For b = 1 To a
        m = Range("a" & b).Value        'значение очередной ячейки
        n = Replace(m, Chr(160), " ")   'заменяем* неразрывные пробелы обычными
        c = n & " "                     'добавляем пробел в конец текста
        d = Len(c)                      'кол-во символов с пробелом в ячейке*
        e = Replace(c, " ", "")         'удалим* пробелы
        f = Len(e)                      'кол-во символов без пробелов
        g = d - f                       'кол-во пробелов = кол-во слов
        q = Range("b" & b).Value        'значение ячейки столбца B
        r = Replace(q, Chr(160), " ")   'заменяем* неразрывные пробелы обычными
        o = " " & r & " "               'добавим пробелы
        'пройдемся циклом по словам очередной ячейки
        i = 1 'начало слова
        For h = 1 To g
            l = Mid(c, i, d)        'текст без предыдущего слова
            j = InStr(l, " ")       'ищем очередной пробел
            k = " " & Mid(c, i, j)  'извлекаем* слово с пробелами
            p = InStr(o, k) 'ищем слово
            'если слово не найдено, выделяем
            If p = 0 Then
                Range("a" & b).Characters(Start:=i, Length:=j - 1).Font.Color = vbRed
            End If
            i = i + j 'начало очередного слова
        Next
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 07.05.2024 в 08:35
Ikurudzz Дата: Вторник, 07.05.2024, 09:06 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

2016
Nic70y, спасибо!!
(не думал что настолько сложное решение(для меня).
А он справится с несколькими тыс значений в столбцах А, В(как далеко вниз таблицы заглядывает)?
 
Ответить
СообщениеNic70y, спасибо!!
(не думал что настолько сложное решение(для меня).
А он справится с несколькими тыс значений в столбцах А, В(как далеко вниз таблицы заглядывает)?

Автор - Ikurudzz
Дата добавления - 07.05.2024 в 09:06
Nic70y Дата: Вторник, 07.05.2024, 09:10 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 8988
Репутация: 2361 ±
Замечаний: 0% ±

Excel 2010
А он справится с несколькими тыс
на данном примере с 5000 строк справился мгновенно.
справиться в любом случае, если тексты слишком длинные и т.п. ну может долго считать будет.
так Вы проверьте


ЮMoney 41001841029809
 
Ответить
Сообщение
А он справится с несколькими тыс
на данном примере с 5000 строк справился мгновенно.
справиться в любом случае, если тексты слишком длинные и т.п. ну может долго считать будет.
так Вы проверьте

Автор - Nic70y
Дата добавления - 07.05.2024 в 09:10
  • Страница 1 из 1
  • 1
Поиск:

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