Макрос по поиску и выделению найденных слов

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Макрос по поиску и выделению найденных слов (Макросы/Sub)

MulleR

Дата: Вторник, 04.12.2018, 18:51 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 44

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Добрый день!

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

Спасибо!

К сообщению приложен файл: 3160265.xlsx (51.2 Kb)

Ответить

krosav4ig

Дата: Вторник, 04.12.2018, 21:38 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 997 ±

Замечаний: 0% ±

Excel 2007,2010,2013

MulleR, не совсем понятно, что и как должно выделяться. Выделите вручную в примере как должно получиться

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Ответить

Kuzmich

Дата: Вторник, 04.12.2018, 21:48 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 714

Репутация: 157 ±

Замечаний: 0% ±

Excel 2003

[vba]

Код

Sub iColorWord()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
Dim FAdr As String
   iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
   Range("B2:B" & iLastRow).Interior.ColorIndex = xlColorIndexNone
With Worksheets("Лист2")
   iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
  For i = 2 To iLastRow
    Set FoundCell = Columns(2).Find(.Cells(i, "B"), , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
      FAdr = FoundCell.Address
      Do
       Cells(FoundCell.Row, "B").Interior.ColorIndex = 6
       Set FoundCell = Columns(2).FindNext(FoundCell)
      Loop While FoundCell.Address <> FAdr
     End If
  Next
End With
End Sub

[/vba]
Запускать при активном листе Лист1

Ответить

Макрос по поиску и выделению найденных слов (Макросы/Sub)

Страница 1 из 1
1