[기초방] VBA 100제 #22 [ 부서별최대값구하기 ]

 

부서별 인사평가가 가장 높은 사람들을 출력하는 문제이다.

보통 이러한 문제는 Max함수를 이용하여 풀면 되니까. max함수를 배열 수식으로 풀면 된다.

그러면 여기서 문제가 있다. 엑셀 함수로는 Ctrl + Shift + Enter를 눌러서 배열수식을 완성하면 되는데 이걸  VBA로 어떻게 표기하냐가 달렸다. 기초방 21번 문제에 사용되었던 Sumifs는 값을 배열로 반환을 하여서 21번 문제 같은 경우에 유용하게 사용되었지만 2019년 이전버전에는 사용할 수 없어 이번에는 2010 버전에도 사용할 수 있는 Max함수로 풀어보려고 한다.

Sumifs와 함께 Maxifs로 풀면 역시 배열로 반환하기 때문에 좀 더 쉽게 풀 수 있다.

시훈아빠의 문제 풀이를 소개한다.

무지님의 함수식 풀이도 함께 올린다.

 

다시 돌아와서 보통 Max함수를 배열수식으로 표기하면 =max((영역 = 기준값)*최대값영역)  이렇게 하면 최댓값이 구해지지만 이걸 VBA에서 바로 표기하면 원하는 값을 가져올 수 없어서 전통적인 방식으로 표기하였다.

[d6].FormulaArray = "=MAX(IF(E6=데이터!$E$6:$E$1105,데이터!$D$6:$D$1105))"
[d6].Copy [d7:d11]

FormulaArray는 Ctrl + Shift + Enter 역할을 한다.

 

그다음 구문은 반복문을 통해서 일치값에 해당문제의 조건값일치 시 해야 하는 노란색 음영을 칠하는 구문이라 그리 어렵지 않게 풀어 나갈 수 있으리라 본다. 

 

이번 문제는 FormulaArray 을 알고 있는지 없는지에 대한 문제였다.

 

보다 많은 풀이를 다 올리지 못해 너무 미안하다.

많은 풀이들을 보면서 더 많은 지적 스펙트럼이 늘어나길 기대한다.

 

Option Explicit
Sub 기초방22()

    Dim rngAll As Range: Set rngAll = [c5].CurrentRegion
    Dim rngA As Range
    Dim rngB As Range
    
    Haja_Format                                                      '= 초기화
    
    rngAll.Copy Sheets("최대값").[c5]                                 '= 최대값 시트에 원본데이터 복사
    [c5].CurrentRegion.RemoveDuplicates 3, 1                         '= 부서명으로 중복제거
    
    [d6].FormulaArray = "=MAX(IF(E6=데이터!$E$6:$E$1105,데이터!$D$6:$D$1105))"
    [d6].Copy [d7:d11]                                               '= 부서별 최대값 구하기
    
    For Each rngB In Range([d6], [d6].End(4))                        '= 원본데이터 영역 순환
    
        For Each rngA In rngAll.Columns(2).Cells                     '= 최대값 영역 순호나
        
            If rngA = rngB Then                                      '= 최대값이 같고
            
                If rngA.Next = rngB.Next Then                        '= 부서명이 같으면
                
                    rngB(1, 0) = rngA(1, 0)                          '= 직원명을 출력
                    rngA(1, 0).Resize(1, 3).Interior.ColorIndex = 6  '= 원본데이터에 노란색으로 표시
                    
                End If
                
            End If
        
        Next rngA
    
    Next rngB
    
    MsgBox "완료"

End Sub
Function Haja_Format()

    Range([c6], [c6].End(2).End(4)).Interior.Color = xlNone
    
    On Error Resume Next                                             '= 최대값 시트가 없을 때 에러방지
        Application.DisplayAlerts = False
            Sheets("최대값").Delete
        Application.DisplayAlerts = False
    On Error GoTo 0
    
    Sheets.Add after:=Sheets("데이터")                                '= 시트추가
    ActiveSheet.Name = "최대값"
End Function

기초방22.xlsm

0.05MB