Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос поиска и закраски ячейки
 
#1
11.01.2016 13:19:12
Всем здравствуйте!!!!
Подскажите пожалуйста, что поменять в коде, чтобы закрышивались не одно совпадения а все найденные на листе ячейки????
Заранее спасибо
Код
Sub Выделение_цветом_машин_для_сводки()
Dim rFndRng As Range, x
  For Each x In Array("VOLVO В 210 СС 73", "10", "50", "95", "5", "143", "660", "470")
    Set rFndRng = Cells.Find(x, , xlValues, xlWhole)
    If Not rFndRng Is Nothing Then rFndRng.Interior.Color = vbRed
  Next
End Sub
 
 
 
#2
11.01.2016 14:12:56
Ну значит нет больше совпадений. Какие значения Вы ищите в этом цикле?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
11.01.2016 14:14:00
к примеру все значения VOLVO В 210 СС 73
 
 
 
#4
11.01.2016 14:16:21
добавляем в код эту функцию
http://excelvba.ru/code/FindAll

и допиливаем ваш макрос:

Код
Sub Выделение_цветом_машин_для_сводки_NEW()
   On Error Resume Next: Dim x
  For Each x In Array("VOLVO В 210 СС 73", "10", "50", "95", "5", "143", "660", "470")
    FindAll(cells, x, xlValues, xlWhole).Interior.Color = vbRed
  Next
End Sub
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#5
11.01.2016 14:18:55
Лучше бы файл-пример приложили. Давно бы уже ответ получили (о! стих получился  :sceptic: )
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#6
11.01.2016 14:30:33
Цитата
Иван Иванов написал: VOLVO В 210 СС 73
Это понятно. Дальше какие? У меня Ваш макрос работает на ура
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
11.01.2016 14:34:02
Вообще код перебора всех найденных приведен даже в справке для метода Find. Можно прямо полностью оттуда взять да вставить...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#8
11.01.2016 14:42:03
Цитата
чтобы закрышивались не одно совпадения а все найденные на листе ячейки
Для начала надо сбросить цветовое окрашивание на листе.
А затем применить метод FindNext
 
 
 
#9
11.01.2016 16:16:15
Почему то ругаеться на FindAll???
Код
Sub Выделение_цветом_машин_для_сводки_NEW()
   On Error Resume Next: Dim x
  For Each x In Array("VOLVO В 210 СС 73", "10", "50", "95", "5", "143", "660", "470")
    FindAll(cells, x, xlValues, xlWhole).Interior.Color = vbRed
  Next
End Sub
 
 
 
#10
11.01.2016 16:22:19
А функцию FindAll вы скачали в стандартный модуль?
 
 
 
#11
11.01.2016 16:40:25
Kuzmich,а как ее скачивать в в стандартный модуль???
я просто код поставил в модуль книги
 
 
 
#12
11.01.2016 16:45:44
Иван Иванов, да Ваш макрос тоже рабочий. Покажите уже файл-пример
Согласие есть продукт при полном непротивлении сторон
 
 
 
#13
11.01.2016 16:54:39
Я бы использовал FindNext, посмотрите в справке
 
 
 
#14
11.01.2016 17:01:11
вот пример
 
 
 
#15
11.01.2016 17:08:56
Код
Sub Выделение_цветом_машин_для_сводки()
Dim rFndRng As Range, x
Dim FAdr As String
     UsedRange.Interior.ColorIndex = xlNone
  For Each x In Array("VOLVO В 210 СС 73", "10", "50", "95", "5", "143", "660", "470")
    Set rFndRng = UsedRange.Find(x, , xlValues, xlWhole)
    If Not rFndRng Is Nothing Then
      FAdr = rFndRng.Address
      Do
        rFndRng.Interior.Color = vbRed
        Set rFndRng = UsedRange.FindNext(rFndRng)
      Loop While rFndRng.Address <> FAdr
    End If
  Next
End Sub
 
 
 
#16
11.01.2016 17:09:18
Kuzmich, прав. Я думал, что там нечто другое.  
Согласие есть продукт при полном непротивлении сторон
 
 
 
#17
11.01.2016 17:16:20
Kuzmich, ошибка 424, Object required???? Что то надо установить мне????
 
 
 
#18
11.01.2016 17:21:32
Макрос в модуль листа "2016"
 
 
 
#19
11.01.2016 17:22:35
Kuzmich,а можно чтобы не в модуль листа???, просто файлик присылают и каждый раз его копировать в лист не удобно
 
 
 
#20
11.01.2016 17:26:17
Можно в стандартный модуль(только свой макрос удалите), но запускать его надо с листа 2016
Код
Sub Выделение_цветом_машин_для_сводки()
Dim rFndRng As Range, x
Dim FAdr As String
     Worksheets("2016").UsedRange.Interior.ColorIndex = xlNone
  For Each x In Array("VOLVO В 210 СС 73", "10", "50", "95", "5", "143", "660", "470")
    Set rFndRng = Worksheets("2016").UsedRange.Find(x, , xlValues, xlWhole)
    If Not rFndRng Is Nothing Then
      FAdr = rFndRng.Address
      Do
        rFndRng.Interior.Color = vbRed
        Set rFndRng = Worksheets("2016").UsedRange.FindNext(rFndRng)
      Loop While rFndRng.Address <> FAdr
    End If
  Next
End Sub
Изменено: Kuzmich - 11.01.2016 17:30:26
 
 
 
#21
11.01.2016 17:30:55
Kuzmich,ставлю в модуль этой книги, но при запуске ошибка 424, Object required?, может я что то не так делаю??????
 
 
 
#22
11.01.2016 17:32:40
Нужно указывать лист, посмотрите код, я поправил.
 
 
 
#23
11.01.2016 18:01:40
Kuzmich,спасибо, все как всегда,четко
 
 
 
Страницы: 1
Читают тему
Наверх