색상 개수와 색깔 표시하기 (동일 시트)

색상 개수와 색깔 표시하기

동일한 값이 3번 이상 들어간 경우 색상을 넣어서 표시하고 싶다면?

아래와 같은 결과를 얻고 싶다.

해당 VBA 샘플파일 첨부합니다.

동일색상처리.xlsm

VBA 코드는 아래와 같습니다.

Option Explicit
Sub Cell_Cnt()

    Dim rngC, rng As Range    '// 각 셀을 넣을 변수
    Dim rngAll As Range  '// 색상 전체 데이터 영역을 넣을 변수
    Dim rngTarget As Range  '// 전체 데이터 영역을 넣을 변수
    Dim cnt, i As Long
    Dim Max_Cnt As Double   '// 상황에 따라 Long, Double 지정
   
    Application.ScreenUpdating = False        '화면 업데이트 (일시) 정지
    Columns("G:H").EntireColumn.ClearContents   '// 값을 산출할 열 전체를 초기화
    '-------------------- B열~D열을 G열에 복사 ----------------------------------
    Set rngTarget = Range([A2], Cells(Rows.Count, "D").End(3))
    i = 2
    For Each rngC In rngTarget
        Cells(i, "G").End(3)(2).Value = rngC.Value
        i = i + 1
    Next rngC
   '------------------- G열의 중복값 모두 제거 ----------------------
    Cells(1, "G").Value = "구분"
    For i = 2 To Cells(Rows.Count, "G").End(3).Row          '// G열 각셀을 순환
        For j = i + 1 To Cells(Rows.Count, "G").End(3).Row
            If Cells(i, "G") = Cells(j, "G") Then
               Cells(j, "G").Delete Shift:=xlUp         '// 셀을 위로 밀면서 삭제
               j = j - 1                                '// 셀이 삭제되었으므로 변수 1을 빼줌
            End If
        Next j
    Next i
    '----------------- 오름차순 정렬 --------------------------------
    With Range([G2], Cells(Rows.Count, "G").End(3)) '//G2 셀부터 마지막 셀까지
        .Sort key1:=Range("G2"), order1:=xlAscending      '//오름차순 정렬
        .HorizontalAlignment = xlCenter     '// 글자를 가운데 정렬
    End With

    '------------------- 중복 횟수 구하기 --------------------------------
    Max_Cnt = 0
    Set rngAll = Range("G2", Cells(Rows.Count, "G").End(3))  '// G열 데이터영역을 변수에
    Cells(1, "H").Value = "횟수"
    For Each rng In rngAll
        For Each rngC In rngTarget
            If rng.Value = rngC.Value Then
                Max_Cnt = Max_Cnt + 1
                rng.Offset(0, 1).Value = Max_Cnt
            End If
        Next rngC
        Max_Cnt = 0
    Next rng
   
    With Range([G2], Cells(Rows.Count, "H").End(3)) '//G2 셀부터 마지막 셀까지
        .Sort key1:=Range("H2"), order1:=xlDescending      '//내림차순 정렬
        .HorizontalAlignment = xlCenter     '// 글자를 가운데 정렬
    End With
   
    '------------------ 색상 칠하기 -----------------------------------------------
    For Each rngC In Range("G2", Cells(Rows.Count, "G").End(3))
       Call ColSet(rngTarget, rngC, rngC.Offset(0, 1))
    Next rngC
       
    '------------------ 개체변수 초기화(메모리 비우기) -----------------------------
    Set rngAll = Nothing
    Set rngTarget = Nothing
   
    MsgBox "작업완료"
   
End Sub

Function ColSet(rngAll, cell, Val) As Long
    Dim rngC As Range
    Dim i As Long
    For Each rngC In rngAll
        If rngC.Value = cell.Value Then
            Select Case Val.Value
                Case 3: rngC.Font.Color = vbRed
                Case 4: rngC.Font.Color = vbBlue
                Case Else: rngC.Font.Color = vbBlack
            End Select
        End If
    Next rngC
End Function