내부고객만족도 평가팀 테이블 만드는 Code

[표 1]을 [표 2]로 바꾸려면?

"내부고객만족도 평가" 진행을 담당하고 있는 직원이 열심히 일하는 모습을 보면서 생각이 떠올라서 만들어 보았습니다. [표 1]과 같은 테이블이 있습니다.

영업1팀부터 재무팀까지 9개 팀이 있는데, 각 팀은 다른 부서로부터 내부고객만족도 평가를 받게 됩니다. 예를 들어 영업1팀은 '마케팅팀/홍보팀/기획팀/인사팀/총무팀/재무팀'으로부터 평가를 받고, 신채널팀은 '기획팀/인사팀/총무팀/재무팀' 등 4개 팀으로부터 평가를 받는 식입니다.

이와 같은 로직으로 [표 2]와 같은 형태로 테이블 모양을 변경하려면 어떻게 해야 할까요? 참고로, 지금까지는 밝은 눈과 재빠른 손을 이용한 노동집약적 방식을 사용하고 있었습니다.

버튼 하나로 테이블 만들기

예제 파일을 열고 '피평가팀 테이블 만들기' 버튼을 클릭해 보세요. 위의 [표 2]와 같은 테이블이 자동으로 휘리릭~~ 만들어집니다.

'피평가팀 테이블 만들기' 버튼에 연결된 코드

'피평가팀 테이블 만들기' 버튼에 연결된 코드입니다.

Sub ChangeTableForm()
    Dim rTable As Range          ' 작업 대상 영역을 지정하기 위한 변수
    Dim rTeamName As Range       ' A열에서 평가받을 팀을 지정하기 위한 변수
    Dim rResult As Range         ' 결과가 표시될 위치를 지정하기 위한 변수
    Dim rCell As Range           ' For Each ~ In ~ Next 문에서 사용될 Flag 변수
    Dim iCol1 As Integer         ' 피평가팀 수를 카운팅 하기 위한 변수
    Dim iCol2 As Integer         ' 평가팀 수를 카운팅 하기 위한 변수
    Dim iRow As Integer          ' For ~ Next 문에서 사용될 Flag 변수
    Dim i As Integer             ' For ~ Next 문에서 사용될 변수
    Dim iX As Integer            ' For ~ Next 문에서 사용될 변수
    Dim iTemp1 As Integer        ' 동일값을 가진 셀 병합 시 사용될 변수
    Dim iTemp2 As Integer        ' 동일값을 가진 셀 병합 시 사용될 변수
    Dim iNum As Integer          ' rResult 영역의 셀 수를 카운팅 하기 위한 변수

    Application.DisplayAlerts = False
                            ' 셀 병합을 할 때마다 경고 메시지 표시하지 않도록 설정
    Set rTable = Range("Start").CurrentRegion   ' 원본 테이블 전체 영역을 지정
    Set rTeamName = rTable.Columns(1)   ' 원본 테이블의 팀명(세로) 지정
    Worksheets.Add                      ' 새로운 워크시트 추가
    Range("A1:C1") = Array("팀명", "평가팀 수", "피평가팀")
                                 ' A1:C1 영역에 새로 만들어질 테이블의 제목 입력

    Set rResult = ActiveSheet.Range("A2")   ' 결과 값을 표시할 시작 위치 지정
    With rResult                        ' 결과를 표시할 셀에 대하여...
        For Each rCell In rTeamName.Cells   ' 피평가팀 영역의 각 셀에 차례로 접근
            If rCell <> "" Then         ' 셀 값이 공란이 아닌 경우에만 아래 구문 실행
                .Offset(i) = rCell      ' 피평가팀을 지정한 위치에 표시
                iCol1 = rTable.Columns.Count - 1  ' 원본 테이블의 열 수를 변수에 할당
                iCol2 = rCell.EntireRow.SpecialCells(xlTextValues).Count - 1
                               ' 각 셀의 행에 몇 개의 값이 있는지 구해서 변수에 할당
                For iRow = 1 To iCol2   ' iCol2 변수 값만큼 For ~ Next문 반복
                    .Offset(i, 0) = rCell   ' 피평가팀을 행 방향으로 이동하면서 표시
                    .Offset(i, 1) = "평가팀" & iRow   ' 몇 번째 평가팀인지 B 열에 표시
                    .Offset(i, 2) = EvalTeam(rCell.Offset(, 1).Resize(, iCol1), rTable.Rows(1), iRow)
                                  ' 사용자 지정함수 EvalTeam 실행 결과를 C열에 표시
                                  ' 이 때 세 가지 정보를 매개 변수로 함께 전달
                    i = i + 1     ' 다음 행으로 이동을 위해 변수 값 1만큼 증가
                Next
            End If
        Next
    End With

    Set rResult = rResult.CurrentRegion.Columns(1)
                                        ' [표 2] 영역의 첫 번째 열을 변수에 지정
    iNum = rResult.Cells.Count          ' rResult 영역의 셀 수를 변수에 지정

    For Each rCell In rResult.Cells     ' 선택 영역의 각 셀에 차례로 접근
        iTemp1 = iTemp1 + 1             ' 이미 검색한 셀의 수는 하나씩 증가
        iTemp2 = iNum - iTemp1          ' 아직 검색하지 않은 셀의 수는 하나씩 감소

        If Len(rCell) > 0 Then   ' 대상 셀의 값이 공란이 아닌 경우에만 아래 구문 실행
            iX = 0                      ' 변수 값 초기화

            For i = 1 To iTemp2   ' 아직 검색하지 않은 셀 수만큼 For ~ Next 문 반복
                If rCell.Offset(i, 0) = rCell Then
                                        ' 현재 셀 내용과 아래 셀 내용이 같으면...
                    iX = iX + 1         ' 변수 값 1 증가
                Else
                    Exit For            ' For ~ Next 문에서 탈출
                End If
            Next

            If iX > 0 Then Range(rCell, rCell.Offset(iX, 0)).Merge
                     ' 변수 iX 값이 0보다 크다는 것은 같은 값을 가진 셀이 2개 이상 있다는
                     ' 의미가 되므로 이런 경우에는 Merge 메서드를 이용하여 셀 병합
        End If
    Next rCell

    With rResult.CurrentRegion     ' 선택한 영역을 대상으로 괘선 그리기
        .BorderAround xlSolid
        .Borders(xlInsideHorizontal).LineStyle = xlSolid
        .Borders(xlInsideVertical).LineStyle = xlSolid
    End With

    Application.DisplayAlerts = True   ' 경고 메시지 표시 상태 초기화
End Sub

사용자 지정 함수 EvalTeam

다음은 위의 'ChangeTableForm' 프로시저에서 호출한 사용자 지정 함수입니다. 세 가지 파라미터를 함께 전달하여 실행합니다.

• rngRow: 평가팀(B:J열)
• rngLabel: 피평가팀(여기서는 4행의 각 셀)
• iRow: 현재 행 번호

Function EvalTeam(rngRow As Range, rngLabel As Range, iRow As Integer)
    Dim rCell As Range         ' For Each ~ In ~ Next 문에서 사용될 Flag 변수
    Dim iCount As Integer

    For Each rCell In rngRow.Cells   ' B:J 열의 각 셀에 대해 반복
        If rCell = "Y" Then          ' 해당 열의 각 셀 값이 "Y"이면...
            iCount = iCount + 1      ' 변수 값을 1만큼 증가

            If iCount = iRow Then    ' iCount와 iRow 변수 값이 같으면...
               EvalTeam = Intersect(rCell.EntireColumn, rngLabel)
                                     ' 두 영역이 교차하는 지점에 있는 셀의 값을
                                     ' 사용자 지정 함수의 결과값으로 돌려주고
               Exit Function         ' 사용자 지정 함수 탈출
            End If
        End If
    Next
End Function

눈으로만 보지 말고 VBA의 디버깅 툴을 이용하거나 빈 종이에 각 변수의 증가되는 값을 기록해 가며 순환문을 몇 바퀴 돌려보면 이해하게 되는 순간이 옵니다. 중간에 포기하지 말고 도전해 보시기 바랍니다.

정리 — 평가팀 테이블 만들기 코드의 구성

구성 요소	역할
ChangeTableForm	새 워크시트에 [표 2]를 만들고 셀 병합과 테두리까지 처리하는 메인 프로시저
EvalTeam	행에서 n번째 Y가 있는 열을 찾아 해당 열의 팀명을 돌려주는 사용자 지정 함수
셀 병합 반복문	아래 셀과 값이 같은 만큼 세어 Merge 메서드로 병합
Application.DisplayAlerts	병합 시 경고 메시지가 뜨지 않도록 False로 설정했다가 끝나면 True로 복원

자주 묻는 질문 (FAQ)

마치며

조금 어려워도 반복문을 한 바퀴씩 따라가다 보면 어느 순간 이해가 됩니다. 포기하지 말고 도전해 보세요!
VBA에 대한 기초 지식을 공부하실 분은 아이엑셀러 닷컴 사이트 정문 왼쪽에 있는 'VBA 강좌 - VBA 입문강좌'를 읽어보시면 이해가 빠릅니다.