[기초방] VBA 100제 #31 [ 소계구하기 ]

소계를 구하는 문제이다 보통이면 부분합을 통해서 구하는 것이 정석이리라 본다.

부분합도 사용하지 않고 배열도 사용하지 않아서 코드가 약간 길어진 거 같다..

 

핵심구문은 소계를 입력한후 소계 이전셀까지의 그룹별 합계를 구하는 구문이다.

Sub Haja_Cut(rngX As Range, cnt&)

    Dim i&

    rngX(1, 1) = "소계"                                
              
    For i = 2 To 5                                     
         rngX(1, i) = Application.Sum(rngX(-cnt + 2, i).Resize(cnt - 1, 1))
    Next i
    
        rngX(1, 1).Resize(1, 5).Interior.ColorIndex = 6  
        rngX(1, 1).Resize(1, 5).Font.Bold = True
        cnt = 0                                          
End Sub

각 그룹의 갯수를  Cnt변수에 담아 Sum함수를 통해서 그룹별 합계를 구하는 구문이 약간의 난이도를 필요로 한다.

 

다음은 유효성검사를 구하기 위해 유효성목록을 고윳값으로 조합을 하여야 한다.

코드를 살펴보면 첫번째 행의 값인 119를 필두로  str 문자열 변수에 중복되지 않은 값들을 콤마로 조합을 하였다. 그러기 위해서 소계는 각 그룹에서 한번만 나오기 때문에 소계를 구성하기 위해 insert 구문이 실행되면 그 바로 아래에 한번씩 str 조합을 하도록 하여 중복값을 피하도록 하였다.

DIM str$: str = [d9]

rngX.Resize(1, 5).Insert                 
            
str = str & "," & rngX(1, 1)

이렇게 do Loop 문을 마치게 되면 마지막 소계를 구하지 못하고 종료되게 되기에 한번 더 소계를 구하는 하위 프로시저를 Call문으로 호출하게 된다.

Loop
    
Call Haja_Cut(rngX, cnt)

마지막으로 Str조합으로 중복없는 목록값인 Str을 유효성 목록에 추가하면 모든 구문이 끝나게 된다.

With [k9].Validation                 
        .Delete                                 
        .Add Type:=xlValidateList, Formula1:=str 
End With

이렇게 구해진 유효성검사를 통해서 목록 중 하나를 호출하였을 때 각 그룹에서 과목의 총합계가 가장 큰 행의 값들을 가져와야 하는데 이는 유효성 검사의 호출값을 전체 범위를 순환하면서 호출값이 일치하는 영역의 값들 중 가장 총합계가 큰 부분의 인덱스를 구해서 가져오도록 하면 된다.

For Each rngA In rngAll
            
    cnt = cnt + 1
    If rngA = Target Then               

        If maxSum <= Application.Sum(rngA(1, 2).Resize(1, 4)) Then

           maxSum = Application.Sum(rngA(1, 2).Resize(1, 4))
           maxRow = cnt

        End If

    End If

Next rngA

이렇게 구해진 MaxRow 값을 순환문을 돌면서

For i = 2 To 5
        
    rngX(1, i) = rngAll(maxRow, i)

Next i

하나씩 출력하게 되면 완성구문을 만날 수 있다.

Option Explicit

Sub 기초방31()

    Dim rngX As Range
    Dim cnt&, str$:   str = [d9]
    Dim bln As Boolean
    
    Application.EnableEvents = False
    
    Haja_format bln                                   '= 초기화
    Set rngX = [d9]
    
    Do Until IsEmpty(rngX)                            '= 성명이 빈셀일때까지 반복
    
        cnt = cnt + 1                                 '= 전체 카운트
        
        If rngX(0, 1) <> "성명" And rngX(0, 1) <> "소계" And rngX(0, 1) <> rngX(1, 1) Then
       '= 첫행이 아니고 / 소계가 아니고 / 성명이 다르면
       
            rngX.Resize(1, 5).Insert                  '= 소계 라인을 형성하기 위해 insert 해라
            
            str = str & "," & rngX(1, 1)              '= 유효성목록을 위해 각 값들을 조합해라
            
            Set rngX = rngX.Offset(-1)                '= 삽입으로 인해 rngX값을 재 설정해라
            
            Call Haja_Cut(rngX, cnt)                  '= 설정된 영역과 카운팅 된 값을 매개변수로 하는
                                                      '= Haja_Cut을 호출해라
        End If
        
        Set rngX = rngX.Offset(1)                     '= 다음을 위해 rngX를 재설정해라
    
    Loop
    
    Call Haja_Cut(rngX, cnt)                          '= 마지막 소계를 위해 한번 더 Haja_Cut을 호출해라
    
    bln = Not bln                                     '= 마지막 format을 위해 bln을 체인지 변수로 사용
    Haja_format bln
    
    With [k9].Validation                              '= 유효성검사 세팅
            .Delete                                   '= 기존값 삭제
            .Add Type:=xlValidateList, Formula1:=str  '= 유효성 목록으로 추가
    End With
    
    Application.EnableEvents = True
     
End Sub

Sub Haja_Cut(rngX As Range, cnt&)

    Dim i&

    rngX(1, 1) = "소계"                                  '= 삽입된 값에 소계를 추가하는 구문
              
    For i = 2 To 5                                       '= 소계 라인에 반복문을 통해 합계를 구해라
         rngX(1, i) = Application.Sum(rngX(-cnt + 2, i).Resize(cnt - 1, 1))
    Next i
    
        rngX(1, 1).Resize(1, 5).Interior.ColorIndex = 6  '= 소계 라인 format 세팅
        rngX(1, 1).Resize(1, 5).Font.Bold = True
        cnt = 0                                          '= 그룹 카운팅 초기화
End Sub

Function Haja_format(bln)

    If bln = False Then                                  '= 초기설정
        [d8].CurrentRegion.Offset(1).Delete shift:=xlUp
        Sheets("문제").[b3].CurrentRegion.Copy Sheets("결과").[d8]
    Else
                                                         '= 후기설정
        [d8].CurrentRegion.Borders.LineStyle = 1
        [d8].CurrentRegion.HorizontalAlignment = xlCenter
    
    End If

End Function

기초방31.xlsm

0.03MB