Страницы: 1
RSS
Сравнение значений в двух диапазонах и выделение совпадений, Нужна помощь с макросом
 
Добрый день! Помогите решить задачу.

Нужен макрос, который ищет значение каждой ячейки из заданного диапазона в другом диапазоне и выделяет ячейку цветом при частичном совпадении текста.

Тоесть.
Что искать: значения Лист1 А1:А10
Где искать: Лист2 А1:А10.
Что сделать при нахождении: выделить желтым ячейку, продолжить поиск.

Здесь нашел пример макроса для одного значения, а мне нужен цикл для каждого значения в заданном диапазоне.
Вот еще макрос для поиска одного значения.

Спасибо.  
Изменено: AlexMarshuk - 24.03.2018 19:18:35 (добавил ссылку на макрос)
 
Здравствуйте. Нужно обязательно макрос? Может формулой как то можно?
 
Таблица в которой нужно искать может достигать 50-60тыс ячеек. И значения которые нужно найти 100-200 ячеек. Через формулу кажется это будет неудобно. Хотя могу ошибаться. Если можете что-то предложить - буду благодарен!  
Изменено: AlexMarshuk - 24.03.2018 16:36:39
 
Цитата
AlexMarshuk написал:
при частичном совпадении текста.
что это значит? На всякий случай- в Приёмах есть раздел посвящённый дубликатам. Там смотрели?
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
Цитата
Bema написал: что это значит?
Вложил пример. Если значения из А1:А3 встречаются в B1:B11, тогда соответствующие ячейки в диапазоне B1:B11 выделить желтым.
Цитата
Bema написал: в Приёмах есть раздел посвящённый дубликатам. Там смотрели?
Да. Ничего не подходит.
 
Вот макрос который ищет вхождение А1 с Лист1 на активном листе и делает заливку ячеек желтым.
Как вместо А1 сделать диапазон А1:А100?
Код
Sub Find()
    On Error Resume Next: Err.Clear
    Dim ra As Range, cell As Range, res, txt$
    res = Sheets("Лист1").Range("A1") 'берем значение из ячейка А1 листа Лист1
    txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub    ' текст не введен, или состоит из пробелов
    Set ra = Range([A1], Range("A" & Rows.Count).End(xlUp))    ' диапазон для поиска
    Application.ScreenUpdating = False
    ra.Font.Color = 0: ra.Font.Bold = 0  'сброс цветового выделения
    ra.Interior.Color = rgbWhite         'сброс заливки
    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    ' если подстрока найдена
                cell.Interior.Color = rgbYellow 'заливка ячейки желтым
            End If
        End If
    Next cell
End Sub
 
Цитата
Нужен макрос, который ищет значение каждой ячейки из заданного диапазона в другом диапазоне
Макрос выделяет значения из первого диапазона во втором красным цветом шрифта
Код
Sub iColorWords()
Dim k As Long
Dim i As Long
Dim j As Integer
Dim iLR As Long
Dim re As Object
Dim objMatches As Object
Dim objMatch As Object
  iLR = Cells(Rows.Count, 2).End(xlUp).Row
      Columns("B").Font.ColorIndex = 0
 For k = 1 To 3
  For i = 1 To iLR
    Set re = CreateObject("VBScript.RegExp")
      re.Global = True
      re.IgnoreCase = True
      re.Pattern = Cells(k, "A")
        Set objMatches = re.Execute(Cells(i, 2))
          If objMatches.Count <> 0 Then
             For j = 0 To objMatches.Count - 1
                Set objMatch = objMatches.Item(j)
                With Cells(i, 2).Characters(Start:=objMatch.FirstIndex + 1, Length:=objMatch.Length).Font
                    .ColorIndex = 3
                End With
             Next
          End If
        Set re = Nothing
  Next
 Next
End Sub
 
Цитата
AlexMarshuk написал:
Ничего не подходит.
Уверены?
Только лучше использовать не УФ а формулу и ту что в D, если  много строк.
Изменено: БМВ - 24.03.2018 19:40:47
По вопросам из тем форума, личку не читаю.
 
Спасибо!!!

Цитата
БМВ написал: Только лучше использовать не УФ а формулу и ту что в D, если  много строк.
А можно подробнее? Не совсем понял как работает формула в УФ.  
 
ну как, как, просто смотрит, а нет ли чего подходящего.
Переменная Connditionas определяет список значений которые надо проверять. Без нее придется фиксированный диапазон использовать
=Лист1!$A$1:INDEX(Лист1!$A:$A;COUNTA(Лист1!$A:$A))
а сам УФ
=SUMPRODUCT(COUNTIF(B1;"*"&Conditions&"*"))>0
считает сколько было найдено совпадений в B, если не 0, то красим.
По вопросам из тем форума, личку не читаю.
 
БМВ,а как вы переменную объявили? Я просто не могу её найти в документе.  
 
CTRL+F3, но я всеж рекомендую формульный вариант, с доп столбцом, для ваших тысяч строк будет пошустрее.
Изменено: БМВ - 24.03.2018 20:34:56
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх