메인 컨텐츠로 가기

Excel에서 다른 색상으로 중복 값을 강조하는 방법은 무엇입니까?

저자: 샤오양 최종 수정 날짜: 2020-12-25
doc 다른 색상 중복 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 키를 눌러이 코드를 실행하면 중복 값을 강조 표시 할 데이터 범위를 선택하라는 메시지 상자가 나타납니다. 스크린 샷을 참조하십시오.

doc 다른 색상 중복 2

4. 그런 다음 OK 버튼을 클릭하면 모든 중복 값이 ​​다른 색상으로 강조 표시됩니다. 스크린 샷을 참조하십시오.

doc 다른 색상 중복 1

최고의 사무 생산성 도구

🤖 Kutools AI 보좌관: 다음을 기반으로 데이터 분석을 혁신합니다. 지능형 실행   |  코드 생성  |  사용자 정의 수식 만들기  |  데이터 분석 및 차트 생성  |  Kutools 기능 호출...
인기 기능: 중복 항목 찾기, 강조 표시 또는 식별   |  빈 행 삭제   |  데이터 손실 없이 열이나 셀 결합   |   수식없이 반올림 ...
슈퍼 조회: 다중 기준 VLookup    다중 값 VLookup  |   여러 시트에 걸친 VLookup   |   퍼지 조회 ....
고급 드롭다운 목록: 드롭다운 목록을 빠르게 생성   |  종속 드롭다운 목록   |  다중 선택 드롭 다운 목록 ....
열 관리자: 특정 개수의 열 추가  |  열 이동  |  Toggle 숨겨진 열의 가시성 상태  |  범위 및 열 비교 ...
특색 지어진 특징: 그리드 포커스   |  디자인보기   |   큰 수식 바    통합 문서 및 시트 관리자   |  자료실 (자동 텍스트)   |  날짜 선택기   |  워크 시트 결합   |  셀 암호화/해독    목록으로 이메일 보내기   |  슈퍼 필터   |   특수 필터 (굵게/기울임꼴/취소선 필터링...) ...
상위 15개 도구 세트12 본문 도구 (텍스트 추가, 문자 제거,...)   |   50+ 거래차트 유형 (Gantt 차트,...)   |   40+ 실용 방식 (생일을 기준으로 나이 계산,...)   |   19 삽입 도구 (QR 코드 삽입, 경로에서 그림 삽입,...)   |   12 매출 상승 도구 (숫자를 단어로, 환율,...)   |   7 병합 및 분할 도구 (고급 결합 행, 셀 분할,...)   |   ... 그리고 더

Excel용 Kutools로 Excel 기술을 강화하고 이전과는 전혀 다른 효율성을 경험해 보세요. Excel용 Kutools는 생산성을 높이고 시간을 절약하기 위해 300개 이상의 고급 기능을 제공합니다.  가장 필요한 기능을 얻으려면 여기를 클릭하십시오...

상품 설명


Office Tab은 Office에 탭 인터페이스를 제공하여 작업을 훨씬 쉽게 만듭니다.

  • Word, Excel, PowerPoint에서 탭 편집 및 읽기 사용, Publisher, Access, Visio 및 Project.
  • 새 창이 아닌 동일한 창의 새 탭에서 여러 문서를 열고 만듭니다.
  • 생산성을 50% 높이고 매일 수백 번의 마우스 클릭을 줄입니다!
Comments (98)
Rated 5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Thanks for the code but this code has a limitation on the amount of highlighted pairs. For example if your table has more then several hundreds duplicate pairs it does not work. Besides in my case it also highlights the cells that are empty. So I have not found any working code so i made another code by myself and it works perfectly with any range. Test please guys:

Sub DuplicatesColoring()
Dim rng As Range
Dim objDictDupes As Object
Dim cell As Range
Dim I As Integer

' Prompt user to select the range
On Error Resume Next
Set rng = Application.InputBox("Please select the range:", Type:=8)
On Error GoTo 0

' Check if a range was selected
If rng Is Nothing Then
MsgBox "No range selected. Exiting the macro.", vbExclamation
Exit Sub
End If

Set objDictDupes = CreateObject("Scripting.Dictionary")
rng.Interior.ColorIndex = -4142
I = 3

For Each cell In rng
If cell.Value <> "" Then ' Check if cell is not empty
If objDictDupes.Exists(cell.Value) Then
If objDictDupes.Item(cell.Value).Interior.ColorIndex <> -4142 Then
cell.Interior.ColorIndex = objDictDupes.Item(cell.Value).Interior.ColorIndex
Else
objDictDupes.Item(cell.Value).Interior.ColorIndex = I
cell.Interior.ColorIndex = I
I = I + 1
End If
Else
objDictDupes.Add cell.Value, cell
End If
End If
Next cell
End Sub
This comment was minimized by the moderator on the site
Hallo. Thats very helpfull. But it seems only working when you do not have much cells.
Is there a way to get it running with more then 100 cells an 15 rows

Thank you in advanced.

Kind regards
Volker
This comment was minimized by the moderator on the site
I had the same problem and besides it was highlighting blank cells. I have made my own code and works perfectly:

Sub DuplicatesColoring()
Dim rng As Range
Dim objDictDupes As Object
Dim cell As Range
Dim I As Integer

' Prompt user to select the range
On Error Resume Next
Set rng = Application.InputBox("Please select the range:", Type:=8)
On Error GoTo 0

' Check if a range was selected
If rng Is Nothing Then
MsgBox "No range selected. Exiting the macro.", vbExclamation
Exit Sub
End If

Set objDictDupes = CreateObject("Scripting.Dictionary")
rng.Interior.ColorIndex = -4142
I = 3

For Each cell In rng
If cell.Value <> "" Then ' Check if cell is not empty
If objDictDupes.Exists(cell.Value) Then
If objDictDupes.Item(cell.Value).Interior.ColorIndex <> -4142 Then
cell.Interior.ColorIndex = objDictDupes.Item(cell.Value).Interior.ColorIndex
Else
objDictDupes.Item(cell.Value).Interior.ColorIndex = I
cell.Interior.ColorIndex = I
I = I + 1
End If
Else
objDictDupes.Add cell.Value, cell
End If
End If
Next cell
End Sub
This comment was minimized by the moderator on the site
Very helpful! Thanks a lot for sharing :-)
This comment was minimized by the moderator on the site
it only applies to 5 duplicates then don't work
This comment was minimized by the moderator on the site
Works perfect.. Thanks alot...
Rated 5 out of 5
There are no comments posted here yet
Load More
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations