엑셀 VBA로 선택과목 신청인원 통계내기

안녕하세요! 꼬비입니다^^

지난 번 엑셀 VBA로 하나의 파일을 여러 개로 분할하기에 이어 또다른 사례를 하나 작성해보려 합니다.

요즘 고등학생들은 대학생들처럼 자신이 들을 과목을 자신이 선택하게 되는데요. 이를 위해서 사전에 교육과정 박람회라는 것을 열어 학생들에게 과목에 대한 설명을 해줍니다. 학생들은 자신이 설명을 듣고 싶은 과목을 사전에 선택을 하겠죠? 우리 부서에서 설문 조사를 하고 통계를 내어야 한 과목으로 몇 개의 교실을 열어야 하는지를 결정할 수 있습니다. 하루 행사를 위해 많은 준비가 필요합니다.

엄두가 나지 않는 이 작업에 저는 역시나 GPT의 도움을 빌리기로 했습니다.

1. 엑셀 파일 전 처리

구글로 받은 설문을 스프레드시트로 받으면 아래와 같이 구성되어 있습니다. 보시는 바와 같이 하나의 셀에 여러 과목이 들어가 있습니다. 제가 원하는 것은 과목별로 몇 명이 신청했는지 인원이 나오는 겁니다.

먼저 선택 과목이 아닌 F(상담), G(내용), H(질문) 열을 삭제했습니다. 이건 GPT보다 제가 빠를 것 같아 간단히 손으로 진행했습니다 ㅎㅎ

2. GPT에게 요청하기

처음에는 C~E열의 1행을 각각 제목으로 하는 파일을 만들고 싶었으나, 파일이 많아지면 불편할 것 같아 탭을 사용하는 것으로 수정하였습니다.

그렇게 나온 VBA 코드는 아래와 같습니다.

Sub SaveColumnsAsSheets()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)  ' 원본 데이터 시트
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  ' 데이터가 있는 마지막 행 찾기
    Dim col As Variant
    Dim newWs As Worksheet
    Dim sheetName As String
    Application.ScreenUpdating = False  ' 화면 깜빡임 방지
    For Each col In Array("C", "D", "E", "F", "G")
        ' 시트 이름 설정
        sheetName = ws.Range(col & "1").Value
        ' 시트가 이미 존재하는지 확인
        On Error Resume Next  ' 오류 무시
        Set newWs = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0  ' 오류 무시 종료
        ' 존재하지 않으면 새 시트 생성
        If newWs Is Nothing Then
            Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            newWs.Name = sheetName
        End If
        ' 데이터 복사
        ws.Range("A1:B" & lastRow).Copy Destination:=newWs.Range("A1")
        ws.Range(col & "1:" & col & lastRow).Copy Destination:=newWs.Range("C1")
        ' 임시 변수 초기화
        Set newWs = Nothing
    Next col
    Application.ScreenUpdating = True  ' 화면 업데이트 재개
End Sub

결과는 아래와 같이 만족스럽게 나왔습니다.

이제는 쉼표로 구분되어 있는 과목을 모두 분리할 차례입니다. 또한 과목명이 아닌 문구는 삭제하고 싶었습니다.

하지만 오류가 떠서 수정 프롬프트를 다시 작성하였습니다.

역시 오류가 떠서 수정 프롬프트를 다시 작성하였습니다.

1행의 데이터까지 분해해버려 수정 프롬프트를 다시 작성하였습니다.

첨자를 쓴 적도 없는데 오류 메시지가 떠서 수정 프롬프트를 다시 작성하였습니다.

그렇게 해서 나온 VBA 코드는 다음과 같습니다.

Sub SplitSubjectsAndRemovePhraseInAllSheets()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Dim cell As Range
    Dim subjects As Variant
    Dim subject As String
    Dim colIndex As Integer
    Dim ignorePhrase As String
    ignorePhrase = "각 과목에 대한 이해가 충분하므로 설명을 듣지 않아도 됩니다."
    Application.ScreenUpdating = False
    ' 모든 시트 순회
    For Each ws In wb.Sheets
        Dim lastRow As Long
        lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
        ' 데이터가 있는 각 행을 순회
        For Each cell In ws.Range("C2:C" & lastRow)
            If InStr(cell.Value, ignorePhrase) > 0 Then
                cell.Value = Replace(cell.Value, ignorePhrase, "") ' 특정 문구 제거
            End If
            subjects = Split(cell.Value, ",") ' 쉼표로 구분하여 배열에 저장
            ' 쉼표로 구분된 값이 존재하는 경우에만 열에 데이터를 분리해서 입력
            If Not IsEmpty(subjects) And UBound(subjects) >= LBound(subjects) Then
                For colIndex = LBound(subjects) To UBound(subjects)
                    subject = Trim(subjects(colIndex)) ' 공백 제거
                    If subject <> "" And colIndex > 0 Then
                        cell.Offset(0, colIndex).Value = subject
                    ElseIf colIndex = 0 Then
                        cell.Value = subject ' 첫 번째 요소는 원래 셀에 입력
                    End If
                Next colIndex
            End If
        Next cell
    Next ws
    Application.ScreenUpdating = True
End Sub

이제야 결과가 아래와 같이 만족스럽게 나왔습니다. 역시 “GPT가 다 해주는 것이 아니다.”라는 말을 실감합니다.

이제 슬슬 지쳐가지만 여기서 끝낼 수는 없습니다.

어쩐 일로 한 번에 제대로 된 VBA 코드를 만들어 줍니다.

Sub CountSubjectsAcrossSheets()

    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Dim subjectList As Object
    Set subjectList = CreateObject("Scripting.Dictionary")
    Dim cell As Range
    Dim subjects As Variant
    Dim subject As Variant
    Dim colIndex As Integer
    ' 모든 시트의 C열 데이터 수집
    For Each ws In wb.Sheets
        Dim lastRow As Long
        lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
        For Each cell In ws.Range("C2:C" & lastRow)
            subjects = Split(cell.Value, ",")
            For Each subject In subjects
                subject = Trim(subject)
                If subject <> "" Then
                    If Not subjectList.Exists(subject) Then
                        subjectList(subject) = 0
                    End If
                    subjectList(subject) = subjectList(subject) + 1
                End If
            Next subject
        Next cell
    Next ws
    ' 새 시트에 과목별 통계 출력
    Dim statsSheet As Worksheet
    Set statsSheet = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    statsSheet.Name = "Subject Statistics"
    statsSheet.Cells(1, 1).Value = "Subject"
    statsSheet.Cells(1, 2).Value = "Count"
    Dim r As Long
    r = 2 ' 시작 행 번호
    For Each subject In subjectList.Keys
        statsSheet.Cells(r, 1).Value = subject
        statsSheet.Cells(r, 2).Value = subjectList(subject)
        r = r + 1
    Next subject
    ' 결과를 보기 좋게 정렬
    statsSheet.Columns("A:B").AutoFit
End Sub

결과는 아래와 같습니다.