728x90

색상 개수와 색깔 표시하기 (동일 시트) - CountIF 함수 이용


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



CountIF 함수를 사용해서 중복되지 않는 값과 몇번이나 들어간 것인지 산출하고 나서

내림차순 정렬을 한 다음에 색깔이 들어간 갯수만큼 다른 색으로 원 데이터에 색깔을 칠하고 VBA Code 입니다.

이 코드가 속도가 훨씬 더 빠릅니다.


Option Explicit
Sub CellCnt_Countif()
    Dim rngC, rngT As Range    '// 각 셀을 넣을 변수
    Dim rngData As Range        '// 전체 데이터 영역을 넣을 변수
    Dim rngVariable As Range  '// 구분자 영역 변수
    Dim i As Integer

    Set rngData = Range([A2], Cells(Rows.Count, "D").End(3))
    Set rngT = [G2]
    Columns("G:H").EntireColumn.Clear   '// 값을 산출할 열 전체를 초기화
   
    For Each rngC In rngData
        Set rngVariable = Range(rngT, rngT.End(4))
        '// COUNTIF(범위,조건) : 범위에서 조건에 맞는게 몇개인지 카운트하라
        If Application.CountIf(rngVariable, rngC) = 0 Then
            rngT.Offset(i) = rngC
            rngT.Offset(i, 1) = Application.CountIf(rngData, rngC)
            i = i + 1
        End If
    Next rngC
   
    With ActiveSheet   '// 결과를 표시할 Sheet 선택
        .Cells(1, "G").Value = "구분"
        .Cells(1, "H").Value = "횟수"
        '--------------- 가운데 정렬, 선그리기 ----------------------------
        .Range("G1").CurrentRegion.HorizontalAlignment = xlCenter
        .Range(.[H2], .Cells(Rows.Count, "H").End(3)).NumberFormat = "#,###" '// 셀서식 : 3단위 콤마
        .Range(.[G1], .Cells(Rows.Count, "H").End(3)).Borders.LineStyle = 1     '// 사용영역 선그리기
        .Columns(7).CurrentRegion.Sort .[H2], 2    '// 값을 내림차순으로 정렬
    End With
  
    '------------------ 색상 칠하기 -----------------------------------------------
    For Each rngC In Range("G2", Cells(Rows.Count, "G").End(3))
       Call ColSet(rngData, rngC, rngC.Offset(0, 1))
    Next rngC
      
    '------------------ 개체변수 초기화(메모리 비우기) -----------------------------
    Set rngData = Nothing
    Set rngVariable = 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

동일색상처리_Coutif.xlsm


CellsCnt_Countif.vbs


728x90
블로그 이미지

Link2Me

,