Массовое "найти и заменить на другой формат цвета ячейки"

Автор alone7, 17.04.2015, 12:05

« назад - далее »

alone7

Добрый день! Интересует возможность автозамены следующим образом:
поиск нескольких ячеек на всех листах документа, содержащих текст "ааааа", "бббб" и т.д.;
замена на ячейки с таким же текстом, но с фоновой заливкой каждого текста своим цветом , т.к. каждому тексту - отдельный цвет ячейки.
Количество условий для поиска и замены со временем будет увеличиваться (но не думаю, что более чем 20 разных цветов).

Здесь предлагалось похожее решение, но только с заменой текста, без влияния на форматирование ячейки:

Цитата: nilem от 08.07.2011, 17:33
Если ничего принципиально не менять, то вот так попробуйте:
Sub ups()
Dim cll As Range
For Each cll In Sheets("Лист1").Range("a1:a6")
    Selection.Replace What:=cll.Value, Replacement:=cll.Next.Value, LookAt:=xlPart
Next
End Sub


alone7

если знатоки полагают, что задача нерешаема, прошу так и написать, чтоб я не тешил себя пустыми надеждами)

cheshiki1

для одного значения
Sub Макрос3()
Dim i%, ff$
Dim Rng As Range, a$
ff = "ааа"
Application.ScreenUpdating = False
For i = 1 To Sheets.Count 'цикл 1 по листам
     Set Rng = Sheets(i).Cells.Find(what:=ff, LookIn:=xlValues, lookAt:=xlWhole)
     If Not Rng Is Nothing Then
     Rng.Interior.ColorIndex = 6
     a = Rng.Address '---запоминаем адрес первой найденной ячейки
    '---цикл 2 по следующим найденным ячейкам
       Do
         Set Rng = Sheets(i).Cells.FindNext(Rng)
          If Rng.Address = a Then Exit Do
         Rng.Interior.ColorIndex = 6
       Loop
   '----конец цикла 2
     End If
Next
Application.ScreenUpdating = True
End Sub

ShAM

Цитата: alone7 от 06.05.2015, 10:16
если знатоки полагают, что задача нерешаема
Думаю, что решаема.
Цитата: alone7 от 17.04.2015, 12:05поиск нескольких ячеек на всех листах документа, содержащих текст "ааааа", "бббб" и т.д.;
замена на ячейки с таким же текстом, но с фоновой заливкой каждого текста своим цветом , т.к. каждому тексту - отдельный цвет ячейки.
Что с этого можно понять? Нафига искать ячейку с ааааа и менять на такую же ячейку? Может нужно только: "каждому тексту - отдельный цвет ячейки"?
Файла нет, нормального объяснения нет!!!  >:(
ЗЫ: cheshiki1, что-то понял видимо  ::)

alone7

суть проблемы не в отсутствии файла с примером,а в том, что данный вопрос по замене цвета на форуме не рассматривался.
Искать ячейки нужно, т.к. искомый текст встречается сотни раз, поэтому и должен быть подкрашен, чтобы выделяться из общей массы.

Для меня, как нуба в данной теме, весьма нагляден макрос cheshiki1, в котором вместо "ааа" я смогу подставить любой текст и поэкспериментировать с ColorIndex.

cheshiki1, благодарю, буду пытаться применить!

cheshiki1

alone7 для нескольких значений нужно делать ещё один цикл в котором перебирать значения и применять для них данный макрос.

alone7

cheshiki1, что-то не смог запустить твой код(
Но зато сам потыкался и получил вот такую штуку, которая работает!!!

Sub Макрос2замен()
'
    Range("A10").Select
    Application.ReplaceFormat.Interior.ColorIndex = 8
    Cells.Replace What:="ааа", Replacement:="ааа", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True
       
        Application.ReplaceFormat.Interior.ColorIndex = 37
    Cells.Replace What:="ббб", Replacement:="ббб", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True
       
    Application.ReplaceFormat.Interior.ColorIndex = 6
    Cells.Replace What:="ввв", Replacement:="ввв", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True
       
    Application.ReplaceFormat.Interior.ColorIndex = 7
    Cells.Replace What:="ггг", Replacement:="ггг", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True
       
End Sub

Serge 007

Цитата: alone7 от 06.05.2015, 23:43...суть проблемы не в отсутствии файла с примером...
Суть проблемы именно в отсутствии файла. Лично я могу решить Вашу задачу, но без файла до конца её не понимаю. Поэтому и не принимаю участия в решении топика. Как и многие другие

Цитата: alone7 от 06.05.2015, 23:43...данный вопрос по замене цвета на форуме не рассматривался...
1. Почему Вы решили что такой вопрос не рассматривался?
2. Даже если и не рассматривался, то какая разница? Все вопросы когда-то на форуме были заданы впервые. По Вашей логике получается что на все вопросы не должно быть ответов, потому что они заданы впервые ;)
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

alone7

уф, сколько демагогии ради того, чтобы создать файл с текстом "аааа" "ббб" "ввв" ))))

cheshiki1

чет я про формат при замене забыл :)
Sub Макрос4()
Dim tx$, cvet$, i%, S
tx = "ааа,ббб"
cvet = "65535,5287936"
For Each S In Split(tx, ",")
    Application.ReplaceFormat.Interior.Color = Split(cvet, ",")(i)
    Cells.Replace What:=S, Replacement:=S, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True
   i = i + 1
Next
End Sub

это не демагогия. просто не всегда можно предугадать что там у вас в файле на самом деле и по 30 раз переписывать код не очень хочется когда начнется, а у меня там то-то.