엑셀 셀 색상 한번에 찾기

Sub 색상별합계적기()
    Dim stat As Worksheet
    Dim src As Worksheet
    Dim cell As Range
    Dim ur As Range
    Dim colorDict As Object
    Dim rgb As Long
    Dim hexCode As String
    Dim i As Long
    Dim ws As Worksheet
    Dim sheetExists As Boolean
    Dim colOffset As Long
    Dim currentCol As Long
    
    ' 색상별통계 시트 확인 및 생성
    sheetExists = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "색상별통계" Then
            sheetExists = True
            Exit For
        End If
    Next ws
    
    If sheetExists Then
        Application.DisplayAlerts = False
        Sheets("색상별통계").Delete
        Application.DisplayAlerts = True
    End If
    
    Set stat = ThisWorkbook.Worksheets.Add
    stat.Name = "색상별통계"
    
    colOffset = 1  ' 시작 열 (A=1)
    
    ' 모든 시트 순회 (색상별통계 제외)
    For Each src In ThisWorkbook.Worksheets
        If src.Name <> "색상별통계" Then
            currentCol = colOffset
            
            ' 시트명 1행에 적기
            stat.Cells(1, currentCol).Value = src.Name
            stat.Cells(1, currentCol).Font.Bold = True
            
            ' 헤더 생성 (2행)
            stat.Cells(2, currentCol).Value = "색상"
            stat.Cells(2, currentCol + 1).Value = "HEX코드"
            stat.Cells(2, currentCol + 2).Value = "합계"
            stat.Cells(2, currentCol + 3).Value = "평균"
            stat.Cells(2, currentCol + 4).Value = "갯수"
            
            ' Dictionary 생성 (색상별 데이터 저장)
            Set colorDict = CreateObject("Scripting.Dictionary")
            
            Set ur = src.UsedRange
            
            ' 모든 셀 순회하며 색상별 데이터 수집
            For Each cell In ur
                rgb = cell.Interior.Color
                
                ' 색상이 있는 경우만 처리
                If rgb <> -4142 And rgb <> 16777215 Then  ' xlNone 및 흰색 제외
                    If Not colorDict.Exists(rgb) Then
                        colorDict.Add rgb, Array(0, 0)  ' (합계, 갯수)
                    End If
                    
                    If IsNumeric(cell.Value) And cell.Value <> "" Then
                        Dim tempArr As Variant
                        tempArr = colorDict(rgb)
                        tempArr(0) = tempArr(0) + cell.Value  ' 합계
                        tempArr(1) = tempArr(1) + 1           ' 갯수
                        colorDict(rgb) = tempArr
                    End If
                End If
            Next cell
            
            ' 결과를 시트에 출력
            i = 3  ' 3행부터 데이터 시작
            Dim key As Variant
            For Each key In colorDict.Keys
                rgb = CLng(key)
                
                ' RGB 값 추출
                Dim rr As Long, gg As Long, bb As Long
                rr = rgb Mod 256
                gg = (rgb \ 256) Mod 256
                bb = (rgb \ 65536) Mod 256
                
                ' HEX 코드 생성
                hexCode = "#" & Right("0" & Hex(rr), 2) & Right("0" & Hex(gg), 2) & Right("0" & Hex(bb), 2)
                
                Dim dataArr As Variant
                dataArr = colorDict(key)
                Dim sumVal As Double, countVal As Long, avgVal As Double
                sumVal = dataArr(0)
                countVal = dataArr(1)
                If countVal > 0 Then
                    avgVal = sumVal / countVal
                Else
                    avgVal = 0
                End If
                
                ' 색상 표시
                stat.Cells(i, currentCol).Interior.Color = rgb
                stat.Cells(i, currentCol).Value = ""
                
                ' HEX 코드
                stat.Cells(i, currentCol + 1).Value = hexCode
                
                ' 합계
                stat.Cells(i, currentCol + 2).Value = sumVal
                
                ' 평균
                stat.Cells(i, currentCol + 3).Value = Round(avgVal, 2)
                
                ' 갯수
                stat.Cells(i, currentCol + 4).Value = countVal
                
                i = i + 1
            Next key
            
            ' 열 너비 조정
            stat.Columns(currentCol).ColumnWidth = 8
            stat.Columns(currentCol + 1).ColumnWidth = 12
            stat.Columns(currentCol + 2).ColumnWidth = 10
            stat.Columns(currentCol + 3).ColumnWidth = 10
            stat.Columns(currentCol + 4).ColumnWidth = 8
            
            ' 다음 시트를 위한 열 위치 (5열 + 1열 공백 = 6열 이동)
            colOffset = colOffset + 6
        End If
    Next src
    
    MsgBox "모든 시트의 색상별 통계 계산이 완료되었습니다.", vbInformation
End Sub