Мне нужно каждый раз проделывать одну и туже операцию: ПОИСК -> НАЙТИ ВСЁ -> выделить все найденные резульаты -> сделать заливку
Можно ли создать пресет\шаблон который применится к новому файлу или создать один файл и вставлять туда новые столбцы, и чтобы применялось условие раскраски ячеек к новым ячейкам
[b]вот готовый файл с раскрашенными ячейками
Мне нужно каждый раз проделывать одну и туже операцию: ПОИСК -> НАЙТИ ВСЁ -> выделить все найденные резульаты -> сделать заливку
Можно ли создать пресет\шаблон который применится к новому файлу или создать один файл и вставлять туда новые столбцы, и чтобы применялось условие раскраски ячеек к новым ячейкам
[b]вот готовый файл с раскрашенными ячейками krisagurbash
krisagurbash, картинка тут не поможет, надо пример файла с пояснением, что как закрашивать. Пока могу только посоветовать почитать про Шаблоны Excel
krisagurbash, картинка тут не поможет, надо пример файла с пояснением, что как закрашивать. Пока могу только посоветовать почитать про Шаблоны ExcelPelena
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
Dim coll AsNew Collection, dupes AsNew Collection, _
cols AsNew Collection, ra As Range, cell As Range, n&
Err.Clear: Set ra = Intersect(Selection, ActiveSheet.UsedRange) If Err ThenExitSub
ra.Interior.ColorIndex = xlColorIndexNone: Application.ScreenUpdating = False For Each cell In ra.Cells ' запонимаем значение дубликатов в коллекции dupes
Err.Clear: IfLen(Trim(cell)) Then coll.Add CStr(cell.Value), CStr(cell.Value) If Err Then dupes.Add CStr(cell.Value), CStr(cell.Value) Next cell For i& = 1To dupes.Count ' заполняем коллекцию cols цветами для разных дубликатов
n = n Mod (UBound(Colors) + 1): cols.Add Colors(n), dupes(i): n = n + 1 Next For Each cell In ra.Cells ' окрашиваем ячейки, если для её значения назначен цвет
cell.Interior.Color = cols(CStr(cell.Value)) Next cell
Application.ScreenUpdating = True EndSub
Dim coll AsNew Collection, dupes AsNew Collection, _
cols AsNew Collection, ra As Range, cell As Range, n&
Err.Clear: Set ra = Intersect(Selection, ActiveSheet.UsedRange) If Err ThenExitSub
ra.Interior.ColorIndex = xlColorIndexNone: Application.ScreenUpdating = False For Each cell In ra.Cells ' запонимаем значение дубликатов в коллекции dupes
Err.Clear: IfLen(Trim(cell)) Then coll.Add CStr(cell.Value), CStr(cell.Value) If Err Then dupes.Add CStr(cell.Value), CStr(cell.Value) Next cell For i& = 1To dupes.Count ' заполняем коллекцию cols цветами для разных дубликатов
n = n Mod (UBound(Colors) + 1): cols.Add Colors(n), dupes(i): n = n + 1 Next For Each cell In ra.Cells ' окрашиваем ячейки, если для её значения назначен цвет
cell.Interior.Color = cols(CStr(cell.Value)) Next cell
Application.ScreenUpdating = True EndSub