색상 개수와 색깔 표시하기 (동일 시트) - 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
'업무 능력 향상 > 엑셀 VBA 활용' 카테고리의 다른 글
AutoFilter를 이용한 셀 일치하는 Row 자동 가져오기 VBA (0) | 2014.02.05 |
---|---|
색상별로 시간합계 구하기 (SumIF 함수 사용) (0) | 2014.02.02 |
업체별 공급가액 합계 및 정렬 2 (SUMIF 함수 사용) (0) | 2014.02.01 |
AutoFilter로 시트별로 분리 저장 (4) | 2014.01.30 |
조건을 만족하지 않는 행 삭제 (0) | 2014.01.30 |