'색상별 합계 VBA'에 해당되는 글 1건

색상별로 시간합계 구하기 (SumIF 함수 사용)

배경색상별로 합계를 구하는 VBA Code 입니다.

기존 자료에 비해서 코드가 더 최적화되어 결과를 산출하는 속도가 빠릅니다.

더 빠르게 최적화 하는 방법도 가능할 거 같은데 아직은 능력이 부족하여 ㅠㅠ

Option Explicit
Sub SameColor_SumIF()
    Dim rngC, rngT As Range    '// 각 셀을 넣을 변수
    Dim rngData, tempData As Range  '// 전체 데이터 영역을 넣을 변수
    Dim sumData As Range      '// Data 시트 합계를 낼 영역 변수
    Dim rngVariable As Range  '// 구분자 영역 변수
    Dim i As Integer
    Dim oldTime As Single       '// 걸린 시간 구하는 변수 지정
   
    oldTime = Timer     '// 시간 변수 설정
    Application.ScreenUpdating = False        '//화면 업데이트 (일시) 정지
    Set rngData = Range([B2], Cells(Rows.Count, "B").End(3))
    Set sumData = Range([B2], Cells(Rows.Count, "B").End(3))
    Set rngT = [D2]
    Columns("D:E").EntireColumn.Clear   '// 값을 산출할 열 전체를 초기화
   
    '-------------------- C열에 색상 및 색상값 복사 ---------------------------
    For Each rngC In rngData
        rngC.Offset(0, 1).Value = rngC.Interior.ColorIndex
        rngC.Offset(0, 1).Interior.ColorIndex = rngC.Interior.ColorIndex
    Next rngC
    '-------------------- C열 기준으로 색상 및 합계 구하기 --------------------
    Set tempData = Range([C2], Cells(Rows.Count, "C").End(3))
    For Each rngC In tempData
        Set rngVariable = Range(rngT, rngT.End(4))  '// 범위가 계속 변함
        '// COUNTIF(범위,조건) : 범위에서 조건에 맞는게 몇개인지 카운트하라
        If Application.CountIf(rngVariable, rngC) = 0 Then
            rngT.Offset(i) = rngC
            rngT.Offset(i).Interior.ColorIndex = rngC.Interior.ColorIndex
            rngT.Offset(i, 1) = Application.SumIf(tempData, rngC, sumData)
            i = i + 1
        End If
    Next rngC
    '--------------- 가운데 정렬, 선그리기, 시간표시, 내림차순 정렬 ----------------------
    With ActiveSheet   '// 현재 시트
        .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
    '---------------- D열 색상만 남기고 값은 지우기 -------------------------------------
    Columns(3).EntireColumn.Clear    '// 임시로 값을 복사했던 열 초기화
    Range(rngT, rngT.End(4)).ClearContents   '//D2 부터 내용 삭제
    '------------------ 개체변수 초기화(메모리 비우기) -----------------------------------
    Set rngData = Nothing

    Set rngVariable = Nothing

    Set sumData = Nothing   
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"
End Sub

SameColor_SumIF.vbs

SameColor_SumIF.xlsm

VBA Code 파일 첨부합니다.