엑셀 VBA로 자료 처리 - 신청자, 회원목록 비교 2

일을 맡기로 하고 집으로 돌아오는 길에 어쩐지 쎄하다 싶었더니 작업량이 만만치 않았습니다.

코딩으로 처리하는 것은 당연히 그렇다고 쳐도 잘못된 형식으로 등록된 데이터를 수정하는 작업에 아주 많이 시간이 소요되고 있습니다.

아침에 일어나자마자 시작해서 밤늦게까지 작업해야 겨우 할 수 있는 수준이죠.

 

첫날에 코딩 구현도 하고 적용도 해야 해서 12시를 넘어 작업하지 않을 수 없었습니다.

 

이건 뭐 예상한 일이니까 그렇지만, 문제는 처리한 작업을 넘긴 후에도 계속 추가 작업을 해야 한다는 것이었습니다.

특히 처리한 일을 요구사항이 달라져서 다시 해야할 때는 아주 짜증스럽습니다.

 

겨우 1차 처리 기한에 맞춰 결과물을 넘기고 다음주까지 한숨 돌리나 했더니 중복자 처리와 추가 처리자 자료가 넘어 와 계속 작업을 하지 않을 수 없다는 겁니다.

뭐 담당자도 계속 밤샘 작업 중인듯 하니 투덜거리기도 어렵긴 하죠.

 

다행히 요즘 딴 일이 없어 이 일에 시간을 다 쓸 수 있었는데, 딴 일과 같이 해야 한다면 펑크를 낼 수 밖에 없을 정도였습니다.

 

그 사이 그때 그때 요청에 따라 추가 처리를 하다 보니 코드도 많이 수정되었습니다.

 

주로 필터, 찾기, 바꾸기 기능과 같은 엑셀 기본 기능과 함께 VBA로 처리하는 작업을 하는데, 사이사이 수작업으로 데이터를 맞추는 일도 많습니다.

 

Public Sub 가족수확인()
    ' 입력된 가족수가 맞는지 확인
    ' 가족수가 10 이상인 경우 표시
    
    시작 = 3
    열 = "H"
    
    끝 = Range(열 & 시작).End(xlDown).Row

    'Application.ScreenUpdating = False

    시작시간 = timer
    i = 시작

    Do
        인원수 = Val(Range(열 & i).Value)
        신청자 = Range("B" & i).Value
        
        If 인원수 >= 10 Then
            Range(열 & i).Previous.Interior.Color = RGB(255, 0, 0)
        End If

        If 인원수 > 1 Then
            For j = 1 To 인원수 - 1
                If 신청자 <> Range("B" & i + j).Value Then
                    인원수 = 인원수 + (j - 인원수)
                    Range(열 & i).Interior.Color = RGB(255, 0, 0)
                    Exit For
                End If
            Next j
        End If

        i = i + 인원수
    Loop While i <= 끝

    'Application.ScreenUpdating = True

    Range(열 & 시작).Select

    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

첫 작업으로 처리 일자에 맞는 데이터만 필터해 새 시트로 옮기고, 가족수확인 프로시저를 실행합니다.

 

본인 뿐만아니라 가족까지 같이 신청을 한 번에 할 수 있도록 입력 폼이 만들어져 있는데, 입력 폼 항목을 제대로 이해하지 못하고 잘못 입력한 경우도 있고, 이중 삼중으로 입력한 경우도 있습니다.

 

수작업으로 확인할 수 밖에 없는 부분입니다.

Public Sub 생년삽입()
    ' K열에 6자리로 만들어진 생년월일에 앞 2자리를 붙여 8자리로 바꿈
    ' 6자리 값 중 앞 숫자가 1, 0인 경우 20, 그외는 19 붙이기

    시작 = 3
    '열 = "K"
    열 = "R"        ' 계좌 생년월일 정리

    끝 = Range(열 & 시작).End(xlDown).Row

    Application.ScreenUpdating = False
    시작시간 = timer
    i = 시작

    Do
        값 = Range(열 & i).Value

        If Len(값) = 6 Then
            If Left(값, 1) = "1" Or Left(값, 1) = "0" Then
                값 = "20" & 값
            Else
                값 = "19" & 값
            End If

            Range(열 & i).Value = 값
        End If

        i = i + 1
    Loop While i <= 끝

    Application.ScreenUpdating = True
    Range(열 & 시작).Select

    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

기본키로 사용할 생년월일을 8자리로 맞추는 수작업을 한참하고 나서 생년삽입 프로시저로 마무리합니다.

 

가족수확인 프로시저나 생년삽입 프로시저는 실행시한이 몇 초 단위로 오래 걸리지 않습니다.

데이터 개수가 많지 않기도 할 뿐만아니라 위에서 아래로 한 번만 쭉 내려오면 끝나기 때문이기도 합니다.

Public Sub 일치항목확인_FindData()
    ' 두 시트 사이에 일치하는 항목을 찾는 방법 개선판
    ' Find FindNext 기능 이용
    
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    Dim strAddr As String
    Dim C As Range
    Dim i As Long

    시트 = "테스트"
    열 = "K"
    비교열 = 2  ' B열

    Set sht1 = ActiveSheet
    Set sht2 = Workbooks("원본_" & 시트 & ".xlsx").Worksheets(시트)

    시작 = 3
    끝 = sht1.Range(열 & 시작).End(xlDown).Row

    열번호 = Range(열 & "1").Column ' 열에 해당하는 숫자 구함 K : 11

    시작시간 = timer
    Application.ScreenUpdating = False

    For i = 시작 To 끝
        If Len(sht1.Range(열 & i).Value) = 8 Then
            Set C = sht2.Columns(비교열).Find(sht1.Cells(i, 열번호).Value, LookAt:=xlWhole)

            If Not C Is Nothing Then
                strAddr = C.Address
                Do
                    If C.Previous.Value = sht1.Range(열 & i).Offset(0, -1).Value Then
                        C.Previous.Interior.ColorIndex = 19
                        sht1.Range(열 & i).Offset(0, -1).Interior.ColorIndex = 19

                        Exit Do
                    End If

                    Set C = sht2.Columns(비교열).FindNext(C)
                Loop While Not C Is Nothing And C.Address <> strAddr
            End If
        End If

        DoEvents
    Next i

    Application.ScreenUpdating = True
    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

본격적인 작업 부분입니다.

일치항목확인 프로시저를 실행합니다.

현재 시트 내용과 원본 시트 내용을 비교해 일치하는 데이터에 채우기 색을 지정합니다.

 

채우기 색을 지정해 두면 필터에서 채우기 색을 기준으로 필터할 수 있고, 시각적으로도 확 표가 나기 때문에 괜찮더군요.

이 프로시저는 4~50,000건 원본에 6,000건 비교 데이터에서 실행했을 때 6~700초 정도 실행시간이 걸렸습니다.

처음 이중 반복문으로 처리할 때는 자그마치 6시간 반이 걸렸었죠.

 

다음 단계로 넘어가기 전 조건부서식에 수식으로 조건을 설정해 중복확인 처리를 합니다. 

Public Sub 거래처입력_중복자제외등()
    ' 처리된 결과 내용을 거래처입력 폼으로 넘기기
    ' 가족사항 중 한 명이라도 확인되지 않는 사람이 있으면 넘기지 않는다
    ' 중복신청자 제외      가족들 색상을 해제

    Dim 원본시트 As Object

    시트 = "테스트"
    시작 = 3
    체크 = True     ' 가족인원수만큼 확인해서 한 명이라도 확인되지 않으면 False

    Application.ScreenUpdating = False
    Set 원본시트 = Workbooks("CustForm_" & 시트 & ".xls").Worksheets("거래처입력")

    i = 시작
    출력 = 4        ' 거래처입력 폼에 나타낼 시작 위치

    Do
        인원수 = Val(Left(Range("H" & i).Value, Len(Range("H" & i).Value) - 1)) '가구원수 확인

        For j = 0 To 인원수 - 1	 ' 존재하지 않는 경우와 중복여부체크
            If Range("J" & (i + j)).Interior.ColorIndex <> 19 Or _
                Range("B" & (i + j)).DisplayFormat.Interior.Color = 16772300 Then
                체크 = False
                Exit For
            End If
        Next j

        If 체크 Then
            원본시트.Range("B" & 출력).Value = Range("B" & i).Value ' 성명
            
            If Len(Range("R" & i).Value) = 8 Then   ' 생년월일 형식에 맞는 경우만 출력
                원본시트.Range("E" & 출력).Value = Range("R" & i).Value ' 생년월일
            End If
            
            원본시트.Range("G" & 출력).Value = Range("Q" & i).Value ' 은행코드
            원본시트.Range("H" & 출력).Value = Range("E" & i).Value ' 계좌성명
            원본시트.Range("I" & 출력).Value = Range("T" & i).Value ' 계좌번호
            원본시트.Range("J" & 출력).Value = 인원수 * 50000
            원본시트.Range("V" & 출력).Value = Range("S" & i).Value ' 휴대전화

            출력 = 출력 + 1

            ' 거래처입력한 셀 색상등록
            Range("C" & i & ":C" & (i + 인원수 - 1)).Interior.Color = RGB(204, 255, 204)
        End If

        i = i + 인원수
        체크 = True

        DoEvents
    Loop While Range("B" & i).Value <> ""

    Application.ScreenUpdating = True
    Beep
    MsgBox "끝"
End Sub

거래처입력 프로시저를 실행해 제출용 결과 파일을 만듭니다.

 

여기까지 처리하면 필요한 작업은 완료된 것입니다.

 

그외 보조 작업용이 몇 가지 있습니다.

Private Sub 숫자만입력(작업열 As String, 출력열 As String)
    ' 내부에서만 호출
    ' 전화번호나 계좌번호 중 숫자만 남기고 나머지 삭제

    시작 = 3
    끝 = Range(작업열 & 시작).End(xlDown).Row

    Application.ScreenUpdating = False

    Columns(출력열 & ":" & 출력열).NumberFormatLocal = "@"
    i = 시작

    Do
        값 = Range(작업열 & i).Value
        변환 = ""

        For j = Len(값) To 1 Step -1
            If IsNumeric(Mid(값, j, 1)) Then
                변환 = Mid(값, j, 1) & 변환
            End If
        Next j

        Range(출력열 & i).Value = 변환
        i = i + 1

        DoEvents
    Loop While i <= 끝

    Application.ScreenUpdating = True
    Beep
End Sub

Sub 숫자로정리()
    Call 숫자만입력("D", "S")
    Call 숫자만입력("G", "T")
End Sub

생년월일이나 계좌번호, 전화번호를 입력할 때 여러 가지 모양으로 입력한 걸 정리하기 위해 사용했습니다.

처음부터 이렇게 처리했어야 하는데, 사용자가 입력한 원본 모양을 유지하려고 하다보니 나중에 이 처리를 하게되서 발생한 문제도 좀 있었습니다.

 

이렇게 처리한다고 해도 어차피 수작없이 필요했습니다.

예를들어 생년월일을 입력할 때 '1990-1-15' 형태로 입력했다면 숫자만 출력하면 '1990115'가 되어 버립니다.

결국 수작업이 필요한 부분이 되죠.

여유가 된다면 입력 문자열을 인식해 처리할 수도 있긴 하겠지만 거기까지 처리하진 못했습니다.

 

Public Function fn숫자만남기기(입력 As String)
    출력 = ""

    For i = Len(입력) To 1 Step -1
        If IsNumeric(Mid(입력, i, 1)) Then
            출력 = Mid(입력, i, 1) & 출력
        End If
    Next i

    fn숫자만남기기 = 출력
End Function

어차피 수작업으로 중간중간 처리하는 부분이 있었기 때문에 나중엔 사용자정의함수로 구현해 사용했습니다.

이게 더 사용하긴 편리하더군요.

 

Sub 은행정리()
    Dim 코드() As String
    Dim 코드시트 As Object
    Dim 코드셀 As Range
    Dim 대상셀 As Range

    Set 코드시트 = Workbooks("은행코드참고자료1.xlsx").Worksheets("변환")
    Set 코드셀 = 코드시트.Range("A2", 코드시트.Range("B2").End(xlDown))

    행 = 코드셀.Rows.Count
    열 = 코드셀.Columns.Count
    대상열 = "P"

    Set 대상셀 = Range(대상열 & "3", Range(대상열 & "3").End(xlDown))
    ReDim 코드(행, 열)
    
    For i = 1 To 행
        For j = 1 To 열
            코드(i, j) = 코드셀(i, j)
        Next j
    Next i
    
    Application.DisplayAlerts = False
    'application.ScreenUpdating = False
    시작시간 = timer
    
    For i = 1 To 행
        대상셀.Replace What:=코드(i, 1), Replacement:=코드(i, 2), LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Next i
    
    'application.ScreenUpdating = true
    Application.DisplayAlerts = True
    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

사용자가 입력한 금융기관명을 금융기관 입력용 파일로 변환하는 작업도 바꾸기로 여러번 작업했었는데, 은행코드참고자료1.xlsx 파일에 입력예시 목록을 등록해 두고 자동 변환하도록 은행정리 프로시저를 만들었습니다.

 

새 자료를 처리할 때마다 생각지도 못한 다양한 오타들이 있었는데, 입력예시 목록에 추가하기만 하면 다음엔 자동으로 처리되니 괜찮은 선택이라 생각합니다.

 

이렇게 작업을 해 자료를 넘겼더니 그 다다음날 실지급 명단이 넘어왔습니다.

 

다음주 처리를 하려면 원본 파일 목록에 실지급자 표시를 해서 재처리 되지 않도록 또 작업을 해야 했습니다.

Public Sub 지급후_거래처폼에있는항목확인()
    ' 거래처폼에 등록된 명단을 신청자에서 찾아 표시
    
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    Dim strAddr As String
    Dim C As Range
    Dim i As Long

    시트 = "테스트"
    열 = "B"
    비교열 = 2  ' B열

    Set sht1 = ActiveSheet
    Set sht2 = Workbooks(시트 & ".xls").Worksheets(1)   ' 첫번째 시트

    시작 = 4
    끝 = sht1.Range(열 & 시작).End(xlDown).Row
    열번호 = Range(열 & "1").Column

    시작시간 = timer
    Application.ScreenUpdating = False

    For i = 시작 To 끝
        Set C = sht2.Columns(비교열).Find(sht1.Cells(i, 열번호).Value, LookAt:=xlWhole)

        If Not C Is Nothing Then
            strAddr = C.Address
            Do
                ' 계좌번호 특수문자 때문에 차이나면 변경된 계좌번호 이용해 처리
                ' 3: 예금주   5:계좌번호  18: 변경한 계좌번호
                '             I: 계좌번호  Z : 변경한 계좌번호
                If C.Offset(0, 3).Value = sht1.Range("H" & i).Value And _
                    C.Offset(0, 5).Value = sht1.Range("I" & i).Value Then
                    
                    C.Offset(0, 3).Interior.ColorIndex = 44
                    sht1.Range("Y" & i).Value = C.Row
                End If

                Set C = sht2.Columns(비교열).FindNext(C)
            Loop While Not C Is Nothing And C.Address <> strAddr
        End If
    
        DoEvents
    Next i

    Application.ScreenUpdating = True
    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

지급후_거래처폼에있는항목확인 프로시저를 실행합니다.

실지급명단을 확인해 처리 파일에 표시를 하는데, 그냥 표시만 하고 끝나는게 아니라 필터해서 잘못 입금되거나 누구를 처리했나는 확인해야 하기 때문에 수작업해야 했습니다.

 

Public Sub 지급후_원본지급확인()
    ' 원본 파일에 지급한 사람은 표시
    
    Dim sht1 As Worksheet
    Dim sht2  As Worksheet
    Dim strAddr As String
    Dim C As Range
    Dim i As Long

    시트 = "테스트"
    열 = "K"
    비교열 = 2  ' A열

    Set sht1 = ActiveSheet
    Set sht2 = Workbooks("원본_" & 시트 & ".xlsx").Worksheets(시트)

    시작 = 3
    끝 = sht1.Range(열 & 시작).End(xlDown).Row
    열번호 = Range(열 & "1").Column

    시작시간 = timer
    Application.ScreenUpdating = False

    For i = 시작 To 끝      ' E, F 열에 색이 설정되어 있으면
        If sht1.Range("E" & i).DisplayFormat.Interior.ColorIndex = 44 Then
            Set C = sht2.Columns(비교열).Find(sht1.Cells(i, 열번호).Value, LookAt:=xlWhole)
    
            If Not C Is Nothing Then
                strAddr = C.Address
                Do
                    If C.Offset(0, -1).Value = sht1.Range("J" & i).Value Then
                        C.Interior.ColorIndex = 44
                    End If
    
                    Set C = sht2.Columns(비교열).FindNext(C)
                Loop While Not C Is Nothing And C.Address <> strAddr
            End If
        End If
        
        DoEvents
    Next i

    Application.ScreenUpdating = True
    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

마무리로 지급후_원본지급확인 프로시저를 실행합니다.

원본 파일에 제외 표시를 합니다.

 

여기에서 끝나면 좋지만 처리를 하다보니 그때그때 필요한 작업이 있어 추가 코드를 만들었습니다.

Public Sub 지급후_추가지급자_추가표시()
    ' 추가지급자 거래처폼명단을 작업 파일에 찾아 추가 표시
    ' 추가 지급자 인원이 많아 눈에 띄게 하기 위한 임시 작업
    ' V열에 표시 달기
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    Dim strAddr As String
    Dim C As Range
    Dim i As Long

    시트 = "테스트"
    열 = "B"
    비교열 = 2  ' B열

    Set sht1 = ActiveSheet
    Set sht2 = Workbooks(시트 & ".xls").Worksheets(1)   ' 첫번째 시트

    시작 = 4
    끝 = sht1.Range(열 & 시작).End(xlDown).Row

    열번호 = Range(열 & "1").Column

    시작시간 = timer
    Application.ScreenUpdating = False

    For i = 시작 To 끝
        Set C = sht2.Columns(비교열).Find(sht1.Cells(i, 열번호).Value, LookAt:=xlWhole)

        If Not C Is Nothing Then
            strAddr = C.Address
            Do
                ' 계좌명, 예금주명 같으면 동명 파일 V열에 표식 달기
                If C.Offset(0, 3).Value = sht1.Range("H" & i).Value Then
                   
                    C.Offset(0, 20).Value = "XXX"   ' 그냥 표식 달기
                End If

				Set C = sht2.Columns(비교열).FindNext(C)
            Loop While Not C Is Nothing And C.Address <> strAddr
        End If
    
        DoEvents
    Next i

    Application.ScreenUpdating = True
    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

나눠진 작업 그룹 중 특히 오류가 많아 시각적으로 표시해 작업하기 위해 임시로 만든 프로시저입니다.

 

Public Sub 임시_계좌명변경()
    ' 거래처폼에 계좌명에 상호가 들어간 경우 해당 동 파일 수정
    
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    Dim strAddr As String
    Dim C As Range
    Dim i As Long

    시트 = "테스트"
    열 = "B"
    비교열 = 2  ' B열

    Set sht1 = ActiveSheet
    Set sht2 = Workbooks(시트 & ".xls").Worksheets(1)   ' 첫번째 시트

    시작 = 4
    끝 = sht1.Range(열 & 시작).End(xlDown).Row
    열번호 = Range(열 & "1").Column

    시작시간 = timer
    Application.ScreenUpdating = False

    For i = 시작 To 끝
        Set C = sht2.Columns(비교열).Find(sht1.Cells(i, 열번호).Value, LookAt:=xlWhole)

        If Not C Is Nothing Then
            strAddr = C.Address
            Do
                ' 예금주, 계좌번호 같음
                If C.Offset(0, 2).Value = sht1.Range("G" & i).Value And _
                    C.Offset(0, 5).Value = sht1.Range("E" & i).Value Then
                    C.Offset(0, 3).Value = sht1.Range("D" & i).Value

                    sht1.Range("I" & i).Value = C.Row
                End If

                Set C = sht2.Columns(비교열).FindNext(C)
            Loop While Not C Is Nothing And C.Address <> strAddr
        End If
    
        DoEvents
    Next i

    Application.ScreenUpdating = True
    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

마찬가지 한번만 쓰고 버릴 요량으로 만든 프로시저인데, 다른 작업 그룹과 달리 계좌명에 추가된 정보가 있어 이걸 남기려고 작업 파일에 수정하는 처리입니다.

 

여기까지 해서 한 주의 작업이 마무리 되고 이젠 새로 접수 받은 자료 처리해야 합니다.

 

이젠 어떻게 작업이 이루어져야 하는지도 파악되고 만들어진 프로시저도 있고, 신청자도 적을거라 예상해서 쉬어지리라 기대하고 있는데, 결과는 내일 보면 알겠죠.