색상별로 시간합계 구하기

색상별로 시간합계 구하기

문의사항이 같은 색으로 더해진 시간들만 더하고 싶을 때

같은 색상별로 시간의 합계를 구하고 싶다면 어떻게 해야 할까요?

먼저 서로 다른 색상을 구해야 합니다. 사실 이 부분 테스트한다고 잘못 생각해서 시간허비 많이 했네요

처음부터 Msgbox 를 사용해서 확인해 가면서 했으면 금방 찾아서 시간낭비는 안했을텐데 ㅠㅠㅠ

Option Explicit
Sub SameColor_Sum()
    Dim rngC, rngT As Range    '// 각 셀을 넣을 변수
    Dim rngData As Range      '// 전체 데이터 영역을 넣을 변수
    Dim rngVariable As Range  '// 색상 데이터 영역 변수
    Dim i As Long
    Dim Max_Cnt As Double   '// 변수 유형을 Integer 로 지정하면 오류 발생
   
    Application.ScreenUpdating = False        '화면 업데이트 (일시) 정지   
    '-------------------- D열에 색상 및 색상값 복사 ----------------------------------
    Set rngData = Range([B2], Cells(Rows.Count, "B").End(3))
    For Each rngC In rngData
        rngC.Offset(0, 2).Value = rngC.Interior.ColorIndex
        rngC.Offset(0, 2).Interior.ColorIndex = rngC.Interior.ColorIndex
    Next rngC
  
    '------------------- D열의 중복값 모두 제거 및 오름차순 정렬 ----------------------
    Set rngVariable = Range("D2", Cells(Rows.Count, "D").End(3))  'D열 데이터영역을 변수에
    For Each rngT In rngVariable                               'D열 각셀을 순환
        If Application.CountIf(rngVariable, rngT) > 1 Then  '각셀의 countif 값을 변수에
            rngT.Resize(, 1).Clear   '그 셀의 데이터를 삭제
        End If
    Next rngT
    Range([D2], Cells(Rows.Count, "D").End(3)).Sort [D2], 1   '//오름차순 정렬
   
    '---------------------- 같은 색상의 값을 더하기 -----------------------------------
    Range([E2], Cells(Rows.Count, "E").End(3)).ClearContents '// 값 초기화
    For Each rngT In rngVariable
        For i = 2 To Cells(Rows.Count, "B").End(3).Row
            If rngT.Value = Cells(i, "B").Interior.ColorIndex Then
                   Max_Cnt = Max_Cnt + Cells(i, "B").Value
                   rngT.Offset(0, 1).Value = Max_Cnt
            End If
        Next i
        Max_Cnt = 0
    Next rngT
   
    '---------------- D열 색상만 남기고 값은 지우기 -------------------------------------
    For Each rngT In rngVariable              'D열 각셀을 순환
        rngT.ClearContents
    Next rngT
       
    With ActiveSheet   '// 결과를 표시할 Sheet 선택
        .Cells(1, "D").Value = "색상"
        .Cells(1, "E").Value = "시간합계"
        '--------------- 가운데 정렬, 선그리기 ----------------------------
        .Range(.[D1], .Cells(Rows.Count, "E").End(3)).HorizontalAlignment = xlCenter
        .Range(.[E2], .Cells(Rows.Count, "E").End(3)).NumberFormat = "h:mm:ss" '// 시간표시
        .Range(.[D1], .Cells(Rows.Count, "E").End(3)).Borders.LineStyle = 1     '// 사용영역 선그리기
        .Range(.[D1], .Cells(Rows.Count, "E").End(3)).Sort .[E2], 2    '// 값을 내림차순으로 정렬
    End With
       
    '------------------ 개체변수 초기화(메모리 비우기) -----------------------------------
    Set rngVariable = Nothing
    Set rngData = Nothing
   
    MsgBox "작업완료"   
End Sub

SameColor_Sum.vbs

Sum_of_Same_Color_Area.xlsm

첨부된 예제 받아서 확인해보세요.

한줄 한줄 실행하는 건 F8키 누르면 됩니다.