Notice
Recent Posts
Recent Comments
Link
«   2025/05   »
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31
Tags
more
Archives
Today
Total
관리 메뉴

STUDY

개표결과 엑셀변환 02: 합계 계산 본문

vba

개표결과 엑셀변환 02: 합계 계산

__main__ 2020. 4. 27. 22:29

 중앙선거관리위원회 홈페이지에서 개표 결과를 복사하여 엑셀 파일에 붙여넣었다. 그런데 관내사전투표수 총합, 당일투표수 총합은 직접 계산해야만 한다. 몇 개의 sheet라면 엑셀 수식으로 할 수 있겠지만, 그 수가 많아지면 수식을 일일히 삽입하는 것은 만만한 작업이 아니다.

 

그림 1. 엑셀 VBA macro를 적용한 모습

 아래는 위 그림과 같은 엑셀 sheet를 자동으로 만들기 위한 VBA macro 코드이다. 일단 이 정도로만 VBA macro를 정의하더라도, 엑셀에 붙여넣은 선거관리위원회의 자료에 "당일 투표"와 "사전 투표" 총합을 계산하여 기록할 수 있다. 그리고 합계에 대한 수치가 맞는지 확인도 가능하다. 이렇게 하면 파일 내의 전체 sheets를 한꺼번에 모두 위 그림 1과 같은 형태로 바꿀 수 있다. 하루 이상의 시간을 들여가면서 지겹게 해야 할 일인데, 길어야 몇 초 내에 끝난다. 

' declare global variables
' keyword `public` can be replaced with `Global`
Public lRows As Long       ' the length of rows
Public lCols As Long       ' the length of columns
Public r As Long           ' var for loop
Public c As Long           ' var for loop
Public sum As Long         ' var for sum


' apply macro to all Worksheets in Workbook
Sub applyMacroToAllSheets()
    Dim Current As Worksheet
    
    For Each Current In ActiveWorkbook.Worksheets
        Current.Activate      ' change focus to another Worksheet
        changeOneSheet        ' apply macro
    Next
End Sub


' macro for single Activesheet
Sub changeOneSheet()
    ' count the number of rows and columns
    
    insRow 2, "관내사전투표", "관내당일투표"
    insRow 1, "합계", "합계확인"
    insRow 1, "국외부재자투표(공관)", "관내사전투표"
    insRow 1, "관내사전투표", "관내당일투표"
    insRow 1, "관내당일투표", ""
    
    sumEachDayVotesByDong  ' sum of each votes (동별 관내당일투표 합계)
    sumTotalEarlyVotes     ' sum of early-votes (관내사전투표 총합)
    sumTotalDayVotes       ' sum of votes (관내당일투표 총합)
    checkTotalValue        ' check total value (합계 비교)
    unmergeSheet           ' unmerge 1st and 2nd rows
    
End Sub


' insert a new row and change color
Sub insRow(nCol As Integer, comStr As String, addStr As String)
    ' the count of rows will be dynamically increased
    ' So, we should add some value to the actual number of rows
    lRows = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 200
    lCols = ActiveWorkbook.ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
    
    For r = 1 To lRows
        If ActiveWorkbook.ActiveSheet.Cells(r, nCol) = comStr Then
            Rows(r + 1).EntireRow.Insert Shift:=xlDown
            Cells(r + 1, nCol).Value = addStr
            Cells(r + 1, nCol).Interior.ColorIndex = 34
        End If
    Next r
End Sub


' sum all votes in each dong
Sub sumEachDayVotesByDong()
    Dim i As Integer
    Dim dongName As String
    Dim cellSumDong As Range
    ' Now, the number of rows is not increasing dynamically
    ' So, we don't have to add extra value to the actual number of rows
    lRows = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
    lCols = ActiveWorkbook.ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
    
    ' first for-next loop for columns
    For c = 3 To lCols
        ' nested for-next loop for rows
        For r = 1 To lRows
            If ActiveWorkbook.ActiveSheet.Cells(r, 2) = "관내당일투표" Then
                dongName = Cells(r + 1, 2).Value
                Set cellSumDong = Cells(r, c)
                sum = 0
                i = r + 1
                Do Until Left(Cells(i, 2).Value, 2) <> Left(dongName, 2)
                    sum = sum + Cells(i, c).Value
                    i = i + 1
                Loop
                cellSumDong.Value = sum
                cellSumDong.Interior.ColorIndex = 34
            End If
        Next r
    Next c
End Sub


' sum all early-votes in each dong
Sub sumTotalDayVotes()
    Dim cellTotal As Range
    lRows = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
    lCols = ActiveWorkbook.ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
    
    For c = 3 To lCols
        For r = 1 To lRows
            If ActiveWorkbook.ActiveSheet.Cells(r, 1).Value = "관내당일투표" Then
                Set cellTotal = Cells(r, c)
            End If
        Next r

        sum = 0
        For r = 1 To lRows
            If ActiveWorkbook.ActiveSheet.Cells(r, 2).Value = "관내당일투표" Then
                sum = sum + Cells(r, c).Value
            End If
        Next r
        cellTotal.Value = sum
        cellTotal.Interior.ColorIndex = 34
    Next c
    
End Sub


' sum total early-votes from all dong
Sub sumTotalEarlyVotes()
    Dim cellTotal As Range
    lRows = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
    lCols = ActiveWorkbook.ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
    
    For c = 3 To lCols
        For r = 1 To lRows
            If ActiveWorkbook.ActiveSheet.Cells(r, 1).Value = "관내사전투표" Then
                Set cellTotal = Cells(r, c)
            End If
        Next r
        
        sum = 0
        For r = 1 To lRows
            If ActiveWorkbook.ActiveSheet.Cells(r, 2).Value = "관내사전투표" Then
                sum = sum + Cells(r, c).Value
            End If
        Next r
        cellTotal.Value = sum
        cellTotal.Interior.ColorIndex = 34
    Next c

End Sub


' macro for comparison
Sub checkTotalValue()
    Dim cellTotal As Range
    Dim rWrong As Long
    lRows = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
    lCols = ActiveWorkbook.ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
    
    For r = 1 To lRows
        If ActiveSheet.Cells(r, 1) = "잘못 투입·구분된 투표지" Then
            rWrong = r
        End If
    Next r
    
    For c = 3 To lCols
        sum = 0
        Set cellTotal = Cells(4, c)
        For r = 5 To 10
            sum = sum + Cells(r, c).Value
        Next r
        cellTotal.Value = sum + Cells(rWrong, c).Value
        cellTotal.Interior.ColorIndex = 34
    Next c
 
End Sub


' unmerge and move content to the lower cell
Sub unmergeSheet()
   Dim txt As String
   Dim lCols As Long
   Dim c As Long
   Dim curCell As Range
   
   lRows = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
   lCols = ActiveWorkbook.ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
   
   For c = 1 To lCols
       Set curCell = Cells(1, c)
       If curCell.MergeCells Then
           curCell.UnMerge                ' UnMerge
           Cells(2, c) = curCell.Value    ' copy content to the lower cell
           curCell.Clear                  ' delete content in original cell
       End If
   Next c
   
End Sub

 

 주의할 것들이 있다. (a) 선거관리위원회가 제공하는 table을 그대로 MS 엑셀이나 Libre office calc에 복사하여 붙일 때, merged cell이나 empty row들이 있다. 예들 들어, 빈 row에서 column 갯수를 계산하면 정확한 값이 안 나온다. (b) 한 엑셀 파일에 정의된 VBA macro를 다른 엑셀 파일에 적용할 때는 어떤 것이 ActiveWorkbook인지 명시적으로 표현해야 한다. (c) 연습용 파일에 정의된 VBA macro를 실전 파일을 열어 적용하려면, 연습용 파일이 열려 있는 상태라야 한다. (c) 각 sheet에서 맨 밑의 "잘못 투입, 구분된 투표지" 행 수치도 합산해야 한다.

 

'vba' 카테고리의 다른 글

개표결과 엑셀변환 01: 제공된 자료의 형태  (0) 2020.04.26
Comments