Note: The other languages of the website are Google-translated. Back to English

Как выделить повторяющиеся значения разными цветами в Excel?

док разные цвета дублирует 1

В Excel мы можем легко выделить повторяющиеся значения в столбце одним цветом с помощью Условное форматирование, но иногда нам нужно выделить повторяющиеся значения разными цветами, чтобы быстро и легко распознать дубликаты, как показано на следующем снимке экрана. Как бы вы могли решить эту задачу в Excel?

Выделите повторяющиеся значения в столбце разными цветами с помощью кода VBA


стрелка синий правый пузырь Выделите повторяющиеся значения в столбце разными цветами с помощью кода VBA

Фактически, у нас нет прямого способа завершить эту работу в Excel, но приведенный ниже код VBA может вам помочь, пожалуйста, сделайте следующее:

1. Выберите столбец значений, дубликаты которых вы хотите выделить разными цветами, затем удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модулии вставьте следующий код в Модули Окно.

Код VBA: выделите повторяющиеся значения разными цветами:

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
      On Error Resume Next
      xCol.Add xCell, xCell.Text
      If Err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xCell.Text)
        If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
        xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
      ElseIf Err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
      End If
      On Error GoTo 0
    Next
End Sub

3, Затем нажмите F5 нажмите клавишу для запуска этого кода, и окно подсказки напомнит вам выбрать диапазон данных, в котором вы хотите выделить повторяющиеся значения, см. снимок экрана:

док разные цвета дублирует 2

4. Затем нажмите OK кнопку, все повторяющиеся значения были выделены разными цветами, см. снимок экрана:

док разные цвета дублирует 1


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (91)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
Это сработало для меня в списке номеров деталей.
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте,

Есть ли способ сделать так, чтобы это влияло только на выделенный столбец, а не на всю строку? Некоторые из смелых красных и синих цветов трудно разглядеть по всей таблице. Спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Это как раз то, что мне было нужно, спасибо. Иногда, когда я запускаю этот код, Excel просто зависает, я использую Office 2016 / Windows 10, есть идеи, почему?
Этот комментарий был сведен к минимуму модератором на сайте
Патрик, выделяй только нужные ячейки. Не выделяйте весь столбец, который будет включать все тысячи пустых ячеек.
Этот комментарий был сведен к минимуму модератором на сайте
я хочу проверить дубликаты для 5000 ячеек, что я не могу сделать. я могу выделить дубликаты до 70-80 ячеек
Этот комментарий был сведен к минимуму модератором на сайте
Sub BuscarD()
Dim xRg как диапазон
Dim xTxt как строка
Dim xCell как диапазон
Dim xChar как строка
Dim xCellPre как диапазон
Dim xCol как коллекция
Дим я пока
Dim J как целое число
Dim K как целое число
Dim xCLR как целое число

хCLR = 28

On Error Resume Next
Если ActiveWindow.RangeSelection.Count > 1 Тогда
xTxt = ActiveWindow.RangeSelection.AddressLocal
Еще
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("Выбор рангом для оценки:", "Дубликаты автобусов", xTxt, , , , , 8)
Если xRg ничего не значит, выйдите из Sub
J = 0
K = 0
Установите xCol = Новая коллекция
Для каждой xCell в xRg
On Error Resume Next
xCol.Добавить xCell, xCell.Text
Если Номер Ошибки = 457 Тогда
Установить xCellPre = xCol(xCell.Text)
Если xCellPre.Interior.ColorIndex = xlNone Тогда
xCellPre.Interior.Color = RGB(255, J, K)
xCell.Interior.Color = RGB(255, J, K)
Если K + xCLR <= 255 Тогда
К = К + хCLR
Еще
Если J + xCLR <= 255 Тогда
K = 0
J = J + xCLR
Еще
MsgBox "!Demasiados datos duplicados!: Reducir переменная xCLR", vbCritical, "Ошибка"
Exit Sub
End If
End If
Еще
xCell.Interior.Color = xCellPre.Interior.Color
End If
ElseIf Err.Number = 9 Тогда
MsgBox "Дублирование повторяющихся данных!", vbCritical, "Ошибка"
Exit Sub
End If
По ошибке GoTo 0
Далее

End Sub

Es ип тема viejo, pero lo dejo por si alguien lo necesita. Con el código anterior y modificando la variable "xCLR", от 1 до 255, можно получить от 4 до 65.000 255 различных цветов. En mi caso, configuré el rojo del RGB con un valor estático de 255 y vario los valores verde y azul (166, X, X). Si se requieren mas colores, se podría alterar el valor del rojo, logrando mas de XNUMXmillones de colores diferentes
Этот комментарий был сведен к минимуму модератором на сайте
Это спасло мне жизнь, большое спасибо, что поделились! Когда я запускаю его примерно на 2000 ячеек со значениями, он выделяет только некоторые дубликаты. Есть ли способ исправить это? Интересно, у него закончились цвета или есть что-то еще.
Этот комментарий был сведен к минимуму модератором на сайте
та же проблема, которую я пытаюсь использовать с парой сотен ячеек, и она очень быстро окрашивается в одни и те же цвета. Это можно как-то исправить? спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Та же проблема. Кто-нибудь разбирается в этом?
Этот комментарий был сведен к минимуму модератором на сайте
У меня была та же проблема, проблема в том, что индекс цвета достигает только 56, поэтому, как только он проходит, он больше не окрашивает ячейки. Чтобы исправить это, я заменил строку «xCIndex = xCIndex + 1» на следующую: Если xCIndex > 55 Then xCIndex = 3 Else xCIndex = xCIndex + 1 End If Со временем начнется повторное использование цветов, но это не было проблемой для меня.
Этот комментарий был сведен к минимуму модератором на сайте
Замена на If xCIndex > 55 Then xCIndex = 3 Else xCIndex = xCIndex + 1 End If не работает. Попытка заставить это работать на 14000 строк, примерно 6000 дубликатов
Этот комментарий был сведен к минимуму модератором на сайте
У меня это сработало, я сделал отступ во второй и четвертой строках. Смотри ниже. Код Джоша выделен жирным шрифтом.

Если Номер Ошибки = 457 Тогда
Если xCIndex > 55 Тогда
хCИндекс = 3
Еще
хСИндекс = хСИндекс + 1
End If
Установить xCellPre = xCol(xCell.Text)
Этот комментарий был сведен к минимуму модератором на сайте
Большое спасибо, Джош, это работает!
Этот комментарий был сведен к минимуму модератором на сайте
Это сработало ИДЕАЛЬНО!! Спасибо. Я сходил с ума, пытаясь найти решение. Ценить вас.
Этот комментарий был сведен к минимуму модератором на сайте
Я пытался запустить это несколько раз, и каждый раз, когда я нажимаю «ОК», он просто отправляет меня обратно на экран модулей. Я использую Эксель 2010.
Этот комментарий был сведен к минимуму модератором на сайте
Это здорово и ИМЕННО то, что я искал! Я включаю этот код в некоторый существующий код — я написал свой код для выбора ячеек, которые я хочу раскрасить, а затем я вызываю код для окрашивания. Единственное, что я не могу понять, это как обойти всплывающее окно msgBox, и мне нужно нажать «ОК». Я новичок в VBA и не могу понять, как изменить этот код... Любые предложения, пожалуйста! :)
Этот комментарий был сведен к минимуму модератором на сайте
Заменить строку: Set xRg = Application.InputBox («пожалуйста, выберите диапазон данных:», «Kutools for Excel», xTxt, , , , , 8)
в
Установить xRg = диапазон ("A1: A100")

или если у вас есть таблица, которую вы можете применить ко всему столбцу таблицы:
Установить xRg = Range("Таблица1[[#Все],[Столбец1]]")

просто замените Table1 на свое имя и Column1 на любой заголовок таблицы, к которому вы хотите применить этот макрос.


С уважением
Войцех
Этот комментарий был сведен к минимуму модератором на сайте
Я очень счастлив, потому что получил то, что мне было нужно. Спасибо
Этот комментарий был сведен к минимуму модератором на сайте
как изменить цвет?
Этот комментарий был сведен к минимуму модератором на сайте
Привет,
Код может только помочь вам добавить другой цвет случайным образом, он не может изменить цвет.
Спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Кажется, что он всегда использует одну и ту же цветовую палитру, но есть ли способ выбрать используемую палитру? Это дает мне действительно темные цвета, через которые текст не читается.
Этот комментарий был сведен к минимуму модератором на сайте
та же проблема и у меня... цвет слишком темный для чтения...
Этот комментарий был сведен к минимуму модератором на сайте
без пустого изменить цвет как??????????????????????
Этот комментарий был сведен к минимуму модератором на сайте
Привет, гопи,
Чтобы избежать пустых ячеек, примените следующий код VBA:
Sub ColorCompanyDuplicates ()
'Обновить Extendoffice 20171222
Dim xRg как диапазон
Dim xTxt как строка
Dim xCell как диапазон
Dim xChar как строка
Dim xCellPre как диапазон
Dim xCIndex As Long
Dim xCol как коллекция
Дим я пока
On Error Resume Next
Если ActiveWindow.RangeSelection.Count > 1 Тогда
xTxt = ActiveWindow.RangeSelection.AddressLocal
Еще
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Установите xRg = Application.InputBox («пожалуйста, выберите диапазон данных:», «Kutools for Excel», xTxt, , , , , 8)
Если xRg ничего не значит, выйдите из Sub
хCИндекс = 2
Установите xCol = Новая коллекция
Для каждой xCell в xRg
On Error Resume Next
Если xCell.Value <> "" Тогда
xCol.Добавить xCell, xCell.Text
Если Номер Ошибки = 457 Тогда
хСИндекс = хСИндекс + 1
Установить xCellPre = xCol(xCell.Text)
Если xCellPre.Interior.ColorIndex = xlNone Тогда xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Тогда
MsgBox «Слишком много компаний-дубликатов!», vbCritical, «Kutools for Excel»
Exit Sub
End If
По ошибке GoTo 0
End If
Далее
End Sub

Надеюсь, это поможет вам, спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Сэр,
Как различать разные цвета, указанные в данных, на основе частоты?
В очень больших данных один и тот же цвет давался неоднократно без учета их частоты.
Этот комментарий был сведен к минимуму модератором на сайте
Извините, можно более подробную информацию, здесь можно прикрепить скриншот.
Спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, у меня Excel 2016, работает ли Alt+F11 для запуска Microsoft VB? является бесплатным программным обеспечением Microsoft Visual Basic? Спасибо.
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте,
Если вы не можете активировать окно Microsoft VB, удерживая клавиши Alt + F11, вы можете нажать «Разработчик» > «Visual Basic», чтобы открыть его.

Пожалуйста, попробуйте, спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Что, если я просто хочу заполнить только двумя цветами, скажем, желтым и красным, несколько раз. Чтобы было ясно, в примере на этой странице «Рэйчел» — желтая, Роуз — красная и снова Сусси — желтая, Теди — красная.
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуй, Селим,
Следующий код может решить вашу проблему, попробуйте.

Sub ColorCompanyDuplicates ()
'Обновить Extendoffice 20170504
Dim xRg как диапазон
Dim xTxt как строка
Dim xCell как диапазон
Dim xChar как строка
Dim xCellPre как диапазон
Dim xRgTemp As Range
Dim xCIndex As Long
Dim xCol как коллекция
Дим я пока
On Error Resume Next
Если ActiveWindow.RangeSelection.Count > 1 Тогда
xTxt = ActiveWindow.RangeSelection.AddressLocal
Еще
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Установите xRg = Application.InputBox («пожалуйста, выберите диапазон данных:», «Kutools for Excel», xTxt, , , , , 8)
Если xRg ничего не значит, выйдите из Sub
хCИндекс = 3
Установите xCol = Новая коллекция
Для каждой xCell в xRg
On Error Resume Next
xCol.Добавить xCell, xCell.Text
Если Номер Ошибки = 457 Тогда
Установить xCellPre = xCol(xCell.Text)
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Тогда
MsgBox «Слишком много компаний-дубликатов!», vbCritical, «Kutools for Excel»
Exit Sub
Еще
xCell.Interior.ColorIndex = xCIndex
Установите xRgTemp = xCell
xCIndex = IIf(xRgTemp.Interior.ColorIndex = 3, 4, 3)
End If
По ошибке GoTo 0
Далее
End Sub

Надеюсь, это поможет вам!
Этот комментарий был сведен к минимуму модератором на сайте
Вот именно этого я и хочу. Большое спасибо, скайян.
Этот комментарий был сведен к минимуму модератором на сайте
Есть ли способ выделить всю строку вместо 1 столбца?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Бобо,
Чтобы выделить всю строку на основе повторяющихся значений ячеек, вы можете применить следующий код VBA:

Sub ColorCompanyDuplicates ()
Dim xRg как диапазон
Dim xTxt как строка
Dim xCell как диапазон
Dim xChar как строка
Dim xCellPre как диапазон
Dim xCIndex As Long
Dim xCol как коллекция
Дим я пока
On Error Resume Next
Если ActiveWindow.RangeSelection.Count > 1 Тогда
xTxt = ActiveWindow.RangeSelection.AddressLocal
Еще
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Установите xRg = Application.InputBox («пожалуйста, выберите диапазон данных:», «Kutools for Excel», xTxt, , , , , 8)
Если xRg ничего не значит, выйдите из Sub
хCИндекс = 2
Установите xCol = Новая коллекция
Для каждой xCell в xRg
On Error Resume Next
xCol.Добавить xCell, xCell.Text
Если Номер Ошибки = 457 Тогда
хСИндекс = хСИндекс + 1
Установить xCellPre = xCol(xCell.Text)
Если xCellPre.Interior.ColorIndex = xlNone, то xCellPre.EntireRow.Interior.ColorIndex = xCIndex
xCell.EntireRow.Interior.ColorIndex = xCellPre.EntireRow.Interior.ColorIndex
ElseIf Err.Number = 9 Тогда
MsgBox «Слишком много компаний-дубликатов!», vbCritical, «Kutools for Excel»
Exit Sub
End If
По ошибке GoTo 0
Далее
End Sub

Пожалуйста, попробуйте, надеюсь, это поможет вам!
Этот комментарий был сведен к минимуму модератором на сайте
как я могу выделить диапазон строк?
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, Хосейн,
Может быть, следующий код может оказать вам услугу, попробуйте.

Sub ColorCompanyDuplicates ()
'Обновить Extendoffice
Dim xRg, xRgRow как диапазон
Dim xTxt, xStr как строка
Dim xCell, xCellPre как диапазон
Dim xCIndex As Long
Dim xCol как коллекция
Дим я пока
Если ActiveWindow.RangeSelection.Count > 1 Тогда
xTxt = ActiveWindow.RangeSelection.AddressLocal
Еще
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Установите xRg = Application.InputBox («пожалуйста, выберите диапазон данных:», «Kutools for Excel», xTxt, , , , , 8)
Если xRg ничего не значит, выйдите из Sub
хCИндекс = 2
Установите xCol = Новая коллекция
Для I = 1 To xRg.Rows.Count
On Error Resume Next
Установить xRgRow = xRg.Rows(I)
Для каждой ячейки xCell в xRgRow.Columns
xStr = xStr и xCell.Text
Далее
xCol.Добавить xRgRow, xStr
Если Номер Ошибки = 457 Тогда
хСИндекс = хСИндекс + 1
Установить xCellPre = xCol(xStr)
Если xCellPre.Interior.ColorIndex = xlNone Тогда xCellPre.Interior.ColorIndex = xCIndex
xRgRow.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Тогда
MsgBox «Слишком много компаний-дубликатов!», vbCritical, «Kutools for Excel»
Exit Sub
End If
По ошибке GoTo 0
xстр = ""
Далее
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Удивительно!! Это мне очень помогло!
А если мне нужно выделить и одиночные? Как я могу это сделать?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Карла

Чтобы выделить строки, включая уникальные, примените следующий код VBA:
Sub ColorCompanyDuplicates()
'Updateby Extendoffice
Dim xRg, xRgRow As Range
Dim xTxt, xStr As String
Dim xCell, xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim xOnlyIndex
Dim I As Long
If ActiveWindow.RangeSelection.Count > 1 Then
    xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
    xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For I = 1 To xRg.Rows.Count
    On Error Resume Next
    Set xRgRow = xRg.Rows(I)
    For Each xCell In xRgRow.Columns
        xStr = xStr & xCell.Text
    Next
    xCol.Add xRgRow, xStr
    If err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xStr)
        If xCellPre.Interior.ColorIndex = xlNone Then
            xCellPre.Interior.ColorIndex = xCIndex
        Else            
        End If
        xRgRow.Interior.ColorIndex = xCellPre.Interior.ColorIndex
    ElseIf err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
    End If    
    On Error GoTo 0
    xStr = ""
Next
For Each xCellPre In xCol
    If xCellPre.Interior.ColorIndex = xlNone Then
        xCIndex = xCIndex + 1
        xCellPre.Interior.ColorIndex = xCIndex
    End If
Next
End Sub

Пожалуйста, попробуйте, надеюсь, это поможет вам!
Этот комментарий был сведен к минимуму модератором на сайте
Да скайян! Ты жжешь! 😀
Можем ли мы выделить всю строку, а не только столбец?

Извините, если раздражаю, но вы мне очень помогли!
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Кария,
Если вам нужно выделить все строки, вам просто нужно выбрать весь диапазон строк при выборе диапазона данных в появившемся диалоговом окне.
Пожалуйста, попробуйте, спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Извините, я не могу 😟
Я думаю, что это неправильно, потому что код работает в столбце, и когда я выбираю строки, они подсвечиваются, но не соответствуют предыдущему критерию.

Код, которым вы поделились ранее, только для дубликатов, работает отлично.
Этот комментарий был сведен к минимуму модератором на сайте
Есть ли способ изменить скрипт для работы (посмотреть) с массивом таблиц вместо столбца? Например, F2:BC117.
Спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Василь,
Чтобы выделить повторяющиеся значения в диапазоне ячеек, попробуйте следующий код vba:

Sub ColorCompanyDuplicates ()
'Обновить Extendoffice
Dim xRg, xRgRow как диапазон
Dim xTxt, xStr как строка
Dim xCell, xCellPre как диапазон
Dim xCIndex As Long
Dim xCol как коллекция
Дим я пока
Если ActiveWindow.RangeSelection.Count > 1 Тогда
xTxt = ActiveWindow.RangeSelection.AddressLocal
Еще
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Установите xRg = Application.InputBox («пожалуйста, выберите диапазон данных:», «Kutools for Excel», xTxt, , , , , 8)
Если xRg ничего не значит, выйдите из Sub
хCИндекс = 2
Установите xCol = Новая коллекция
Для I = 1 To xRg.Rows.Count
On Error Resume Next
Установить xRgRow = xRg.Rows(I)
Для каждой ячейки xCell в xRgRow.Columns
xStr = xStr и xCell.Text
Далее
xCol.Добавить xRgRow, xStr
Если Номер Ошибки = 457 Тогда
хСИндекс = хСИндекс + 1
Установить xCellPre = xCol(xStr)
Если xCellPre.Interior.ColorIndex = xlNone Тогда xCellPre.Interior.ColorIndex = xCIndex
xRgRow.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Тогда
MsgBox «Слишком много компаний-дубликатов!», vbCritical, «Kutools for Excel»
Exit Sub
End If
По ошибке GoTo 0
xстр = ""
Далее
End Sub

Надеюсь, это поможет тебе.
Этот комментарий был сведен к минимуму модератором на сайте
Я новичок в VBA. Есть ли способ, которым нам не нужно запускать макрос снова и снова, он автоматически выделяется, даже если новые ячейки копируются в столбец, где запрограммирован макрос?
Этот комментарий был сведен к минимуму модератором на сайте
Это действительно здорово, но окрашивание остановилось после 66-го ряда (9 цветов). Как я могу это продлить?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Анри,
Приведенный выше код хорошо работает на моем листе, я тестирую его на 300 сотнях строк.
Пожалуйста, попробуйте еще раз. Или вы можете отправить файл вашей рабочей книги на мою учетную запись электронной почты.
Моя учетная запись электронной почты: skyyang@extendoffice.com
Этот комментарий был сведен к минимуму модератором на сайте
есть некоторая ошибка в настройке colorindex, xCindex будет больше 56, если на вашем листе 56 строк данных, система проигнорирует предложение:
Если xCellPre.Interior.ColorIndex = xlNone Тогда xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
Я исправляю программу, как показано ниже: \
если Err.number=457 то
если xCellPre.Text<>xCell.Text Тогда
хСиндекс=хСиндекс+1
ENDIF
набор.....
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте,
мой лист excel имеет 11000 строк данных.
как я могу расширить его, чтобы выделить все дубликаты в этом длинном столбце.

он остановился на 77-м ряду.

Благодаря,

AK
Этот комментарий был сведен к минимуму модератором на сайте
Это действительно здорово, но окрашивание прекратилось после 76-го ряда (5 цветов). Как я могу это тоже продлить?
Этот комментарий был сведен к минимуму модератором на сайте
Моя электронная таблица также перестала окрашиваться на 178, и у меня более 400 строк. Как это исправить?
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, Кэрол,
Не могли бы вы отправить свою книгу на мой адрес электронной почты, я могу помочь вам найти проблему.
Мой адрес электронной почты: :skyyang@extendoffice.com
Здесь еще нет комментариев
Загрузить ещё
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL