В макросе перебираете циклом все ячейки из столбца, где у вас могут быть задвоенные значения, и если найдено задвоенное значение, то закрашиваете определенным цветом. Вот и макрос, соответствующий вашему вопросу. Если не понравился ответ, или вы считаете его не полным, то потрудитесь прочитать правила и правильно задать вопрос (о чем вас уже просили).
В макросе перебираете циклом все ячейки из столбца, где у вас могут быть задвоенные значения, и если найдено задвоенное значение, то закрашиваете определенным цветом. Вот и макрос, соответствующий вашему вопросу. Если не понравился ответ, или вы считаете его не полным, то потрудитесь прочитать правила и правильно задать вопрос (о чем вас уже просили).SkyPro
skypro1111@gmail.com
Сообщение отредактировал SkyPro - Среда, 02.10.2013, 17:44
Конкретно: а) Вы не прочитали правила форума. б) Нет файла примера. в) Вы написали не вопрос, а набор слов. г) Неоднократные просьбы прочитать правила и понятно сформулировать ваш вопрос вы игнорируете.
PS: К сожалению сегодня сильные магнитные бури, в связи с чем телепатия не функционирует. Поэтому для получения ответа вам таки придется напрячься.
Конкретно: а) Вы не прочитали правила форума. б) Нет файла примера. в) Вы написали не вопрос, а набор слов. г) Неоднократные просьбы прочитать правила и понятно сформулировать ваш вопрос вы игнорируете.
PS: К сожалению сегодня сильные магнитные бури, в связи с чем телепатия не функционирует. Поэтому для получения ответа вам таки придется напрячься.
В общем я установил макрос, который выделяет повторяющиеся ячейки одним цветом, а мне надо разным. Ниже вставил сам макрос, может быть в нем что надо изменить или как быть
Dim coll As New Collection, dupes As New Collection, _ cols As New Collection, ra As Range, cell As Range, n& Err.Clear: Set ra = Intersect(Selection, ActiveSheet.UsedRange) If Err Then Exit Sub
ra.Interior.ColorIndex = xlColorIndexNone: Application.ScreenUpdating = False For Each cell In ra.Cells ' çàïîíèìàåì çíà÷åíèå äóáëèêàòîâ â êîëëåêöèè dupes Err.Clear: If Len(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& = 1 To 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 End Sub [moder]Оформляйте коды тегами и при копировании включайте русскую раскладку[/moder]
В общем я установил макрос, который выделяет повторяющиеся ячейки одним цветом, а мне надо разным. Ниже вставил сам макрос, может быть в нем что надо изменить или как быть
Dim coll As New Collection, dupes As New Collection, _ cols As New Collection, ra As Range, cell As Range, n& Err.Clear: Set ra = Intersect(Selection, ActiveSheet.UsedRange) If Err Then Exit Sub
ra.Interior.ColorIndex = xlColorIndexNone: Application.ScreenUpdating = False For Each cell In ra.Cells ' çàïîíèìàåì çíà÷åíèå äóáëèêàòîâ â êîëëåêöèè dupes Err.Clear: If Len(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& = 1 To 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 End Sub [moder]Оформляйте коды тегами и при копировании включайте русскую раскладку[/moder]KARMAn