Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Подсветка значения в диапазоне (столбце), если в тексте в ячейке есть данное значение
 
#1
29.05.2025 16:43:26
Доброго дня!
Помогите решить задачу:
В диапазоне "I9:I108" в ячейках текст (планируемые задачи). В столбце P перечислены регионы (н-р МОСК, ННОВ, САР, НСИБ).
Как сделать (желательно макросом), чтобы если в тексте планируемых задач есть "МОСК", то при активации этой ячейки с задачей "МОСК"  в столбце P подсвечивалось цветом.
Заранее благодарен!
Изменено: evg_glaz - 29.05.2025 16:48:00
 
 
 
#2
29.05.2025 17:43:04
В модуль листа
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    Dim cell As Range
    For Each cell In Range("P2", Range("P2").End(xlDown)).Cells
        dict(cell.Value) = cell.Address
    Next cell
    
    Dim key As Variant
    For Each key In dict.Keys
        If Target.Value Like "*" & key & "*" Then
            Range(dict(key)).Interior.Color = vbYellow
            Exit Sub
        End If
    Next key
    
    Set dict = Nothing
End Sub
 
 
 
#3
29.05.2025 17:51:56
В модуль листа
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Range("P2:P" & Cells(Rows.Count, "P").End(xlUp).Row).Interior.Color = Range("U2").Interior.Color
If Not Intersect(Target, Range("I2:I" & Cells(Rows.Count, "I").End(xlUp).Row)) Is Nothing Then
  If Target.Count = 1 Then
    Application.ScreenUpdating = False
    Dim iCl As Range
    For Each iCl In Range("P2:P" & Cells(Rows.Count, "P").End(xlUp).Row)
      If Target.Value Like "*" & iCl & "*" Then
        iCl.Interior.Color = Range("U1").Interior.Color
        Exit For
      End If
    Next
  End If
End If
Application.ScreenUpdating = True
End Sub
Изменено: Sanja - 29.05.2025 18:14:45
Согласие есть продукт при полном непротивлении сторон
 
 
 
#4
29.05.2025 17:55:41
Dmitriy XM, маленько криво - подсвечивает, но потом остаются желтыми ячейки.
СПАСИБО в любом случае!!!
 
 
 
#5
29.05.2025 17:56:51
Sanja, то что надо!
Большое спасибо за очень оперативное решение задачи!
Хорошего вечера (или ночи)))
 
 
 
#6
30.05.2025 09:11:42
Sanja, в примере всё работает, в моем файле ругается на строку
Код
                arr = Range("P2:P" & Cells(Rows.Count, "P").End(xlUp).Row)
именно arr выделяет синим.
Если закомментировать Option Explicit,
Заменил код на измененный Вами, но всё равно цвет по умолчанию срабатывает, но подсветки не происходит.

Нашел ошибку... в своих руках/глазах. Всё отлично работает, большое спасибо!
Изменено: evg_glaz - 30.05.2025 09:44:15
 
 
 
#7
14.07.2026 15:18:33
Доброго дня!
Изменено: evg_glaz - 14.07.2026 15:19:31
 
 
 
#8
14.07.2026 15:32:32
Sanja, немного исправил Ваш код для работы в другой книге
Если код
Код
For Each iCl_2 In Sheets("Телефоны").Range("E6:E" & Cells(Rows.Count, "E").End(xlUp).Row)
то ищет в диапазоне до 108 строки включительно, если
Код
For Each iCl_2 In Sheets("Телефоны").Range("E6:E1000")
то всё ОК.
В ТЗ я написал -
Цитата
написал:
В диапазоне "I9:I108"
А в Вашем коде это где указано...? Или глаза не видят уже мои)))))) или в лыжах я обутый стою..... но именно после 108 строки перестает данные выдавать
Изменено: evg_glaz - 14.07.2026 15:32:53
 
 
 
#9
14.07.2026 15:40:01
В этой части исходной строки
Код
........Cells(Rows.Count, "E").End(xlUp).Row...

Вычисляется номер строки последней ячейки с данными в столбце 'E'.
До этой ячейки и осуществляется цикл.
Если этf ячейка в строке 108 значит до нее и ищет
Согласие есть продукт при полном непротивлении сторон
 
 
 
#10
14.07.2026 16:05:59
Sanja, на данный момент в этом диапазоне 372 строки (и будет конечно больше), вот я и никак не въеду в чем дело.
В моем варианте Вашего кода макрос ищет значение в столбце Е на листе Телефоны и передает его в ячейку W16 листа КАЛЕНДАРЬ для дальнейшей работы с данной ячейкой, но находит не ниже 108 строки листа Телефоны)))
Пропущенных пустых ячеек нет
Изменено: evg_glaz - 14.07.2026 16:07:48
 
 
 
#11
14.07.2026 16:07:35
Файл приложите
Согласие есть продукт при полном непротивлении сторон
 
 
 
#12
14.07.2026 16:34:38
Sanja, с телефона, с компа xlsm никак
 
 
 
#13
14.07.2026 16:45:46
Так?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#14
14.07.2026 17:03:30
Sanja, так точно! Спасибо!
 
 
 
#15
15.07.2026 10:44:59
Sanja, добрый день!
Если в тексте ячейки столбца "I" не содержится переменная iCl, то в ячейке W16 остается ранее найденное значение. Как прописать в коде, чтобы W16 = "" (или очищалась), если переменная отсутствует
 
 
 
#16
15.07.2026 11:14:08
evg_glaz, я понимаю, что Ваш последний вопрос по тому же файлу, но какое отношение он имеет к названию Темы?
Цитата
Подсветка значения в диапазоне...
ПРАВИЛА ФОРУМА, Обязательно к прочтению перед созданием новой темы
Цитата
2.6. Один вопрос - одна тема. Не следует в открываемой теме обозначать и задавать сразу несколько вопросов.
Согласие есть продукт при полном непротивлении сторон
 
 
 
#17
12.08.2026 16:12:24
Добрый день всем!
Помогите дописать код, пожалуйста:
в вышеуказанном файле из #13 (Спасибо Sanja!)поиск происходит на листе "Телефоны ДИ". Как дописать код, чтобы поиск проходил одновременно еще в 2-х листах, например "Телефоны ОБЩ" и "Телефоны РУК"
Во всех листах искомые значения в одинаковых диапазонах "Е6:Е"
Изменено: evg_glaz - 12.08.2026 17:05:30
 
 
 
Страницы: 1
Читают тему
Наверх