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

며칠전 지인이 일을 좀 도와 달라고 연락이 왔습니다.

 

신청자 파일과 회원 목록 파일을 비교해 정상 회원인지 확인하고, 잘못된 신청자를 제외한 나머지를 신청확정 파일로 정리하는 작업이었습니다.

 

신청자 파일, 회원 목록 파일, 신청확정 파일 모두 엑셀 파일이라 엑셀 VBA를 이용하면 딱 좋은 업무라고 생각했습니다.

 

총 데이터 건수는 100,000건 정도인데, 각 지역별로 나눈 8개 파일이고, 파일 중 많은 데이터는 35,000건 정도였습니다.

 

모두 모아 한꺼번에 처리할까 했는데, 어차피 나눠져 있어 그냥 나눠진 파일 단위로 처리하기로 했습니다.

그런데 파일을 나누지 않고 작업했더라면 정한 시간 내에 처리 못할 뻔 했었습니다.

 

방문해 처리 내용을 듣고, 데이터를 잠깐 봤는데, 신청자 파일에 입력 형태가 엉망이었습니다.

 

사용자가 웹 환경에서 직접 입력해 신청하는 형태였는데, 따로 입력 제어를 하지 않았나 보더군요.

중간 중간 빈 칸을 넣은 것도 많고, 휴대전화 입력 칸에는 숫자 사이를 마이너스(-)로 구분한 건 그렇다 쳐도 틸드(~), 언더바( _ ), 도대체 어떻게 입력했는지 알 수 없는 긴 마이너스 문자 등 난리였습니다.

심지어 한 칸에 여러 명의 정보를 입력한 것도 있었는데, 이런 건 어차피 처리 대상이 될 필요가 없는 것이라 신경쓰지 않았습니다.

 

다른 항목들도 정제되지 않은 형태로 입력되었는데, 실제 회원 여부를 파악하는 성명과 생년월일 항목만 적당히 바꿔 회원 목록 파일과 비교하기로 했습니다.

 

성명, 생년월일 항목에서 바꾸기 기능으로 빈칸을 제거하고, 생년월일은 6자리, 8자리, 아예 주민등록번호 다 입력한 경우, 년월일로 표현한 경우등 한꺼번에 기능을 통해 정리할 수 없어서 Len 함수로 길이를 파악한 다음 6 또는 8 값을 제외한 다른 셀값을 수작업으로 정리했습니다.

 

가령 '90-1-10'으로 입력된 경우나 '79년 10월 1일'로 입력된 경우엔 단순히 마이너스(-) 기호를 제거하거나 '년월일'을 없애버리면 파악되지 않기 때문에 열 전체를 복사해 원본 옆 열에 붙여넣고, 필터 기능으로 걸러 수작업으로 변경했습니다.

한 파일마다 70~90 셀 정도가 수정 대상이었습니다.

 

모든 작업을 프로그래밍으로 해결해야 한다면 구현하는데 오히려 오랜 시간이 걸려 시간 내 작업을 완료할 수 없었을텐데 수작업을 염두에 두고 처리하니 쉽게 구현할 수 있었습니다.

 

6자리로 작성된 값은 VBA로 8자리로 일괄 수정했는데, 비교 대상값이 8자리로 등록되어 있었기 때문입니다.

Public Sub 생년삽입()
    ' K열에 6자리로 만들어진 생년월일에 앞 2자리를 붙여 8자리로 바꿈
    ' 6자리 값 중 앞 숫자가 1, 0인 경우 20, 그외는 19 붙이기
    
    시작 = 3
    열 = "K"
    
    끝 = 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

VBA  코드 중 주의할 점은 6자리 생년월일 중 첫 숫자가 0, 1인 경우 앞에 '20'을 붙이도록 구현한 것입니다.

만약 신청자 중 2020년 출생자가 있다면 앞에 '20' 대신에 '19'가 붙게 되는 것이었습니다.

그런 경우는 없을꺼라 보고 작성했습니다.

처리하는 데이터 중 1920년대 생이 있었기 때문이었는데, 만약 올해(2020년)이 아닌 내년이나 그 이후에 실행한다면 앞자리가 '2'로 시작하는 경우라면 표시를 해 사람이 선택하도록 해야할 부분입니다.

 

비교할 항목을 정리한 뒤 이제 신청자와 회원 목록을 비교하는 작업입니다.

 

신청자 파일 반복문 안에 회원 목록 파일 반복문을 넣어 비교하는 방식으로 구현했습니다.

반복문을 겹쳐 하나씩 비교해 처리하는 방식인거죠.

Public Sub 일치항목확인()
    ' 원본 파일 해당 시트에서 같은 데이터 찾아 색 표시
    ' 비고 향목은 가족사항_성명=성명, 가족사항_생년월일=생년월일
    
    Dim 원본시트 As Object
    
    시트 = "테스트"
    
    시작 = 3
    끝 = Range("K" & 시작).End(xlDown).Row
    
    On Error Resume Next    ' 메모를 중복 삽입하면 오류나는 문제를 무시하도록
    
    Application.ScreenUpdating = False
    시작시간 = timer
    
    Set 원본시트 = Workbooks("원본_" & 시트 & ".xlsx").Worksheets(시트)
    
    For i = 시작 To 끝
        If Len(Range("K" & i).Value) = 8 Then
            j = 2
            
            Do
                If Range("J" & i).Value = 원본시트.Range("A" & j).Value And _
                    Val(Range("K" & i).Value) = 원본시트.Range("B" & j).Value Then
                    
                    If 원본시트.Range("A" & j).Interior.ColorIndex = 19 Then
                        Range("J" & i).AddComment "중복"
                        원본시트.Range("A" & j).AddComment "중복"
                    End If
                    
                    Range("J" & i).Interior.ColorIndex = 19
                    원본시트.Range("A" & j).Interior.ColorIndex = 19
                
                    Exit Do
                End If
                
                j = j + 1
            Loop While 원본시트.Range("A" & j).Value <> ""
        End If
    Next i
    
    Application.ScreenUpdating = True
    
    Set 원본시트 = Nothing
    
    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

등록된 회원이 맞는지를 표시하기 위해 신청자 파일의 성명에 색상(ColorIndex : 19)을 표시하고, 한 번 확인했다는 의미로 회원 목록 파일에도 색상을 표시했습니다.

그리고 한 번 이상 확인을 했다면 신청 자체를 두 번 이상 했다는 의미이므로 '중복'이라는 메모를 표시하게 했습니다.

반복 신청이면 2번이든 3번이든 구분할 필요가 없어 모두 중복 메모만 표시하면 되었습니다.

 

개수가 많지 않은 파일에선 크게 문제되지 않았는데, 신청자 23,464건, 회원 목록 32,289건인 파일을 대상으로 실행했더니 실행시간이 자그마치 6시간 30분 정도 걸렸습니다.

 

처음 실행하고는 '좀 걸리구나' 싶었는데, 머리를 감고 와도 그대로 멈춰있어서 '이래선 안되겠구나' 싶어 다른 컴퓨터에서 나머지 파일에 대한 작업을 했습니다.

 

건수가 많은 다른 파일은 파일을 여러 개로 쪼개 5,000~6,000건 정도로 분리해 작업을 했습니다.

 

당장 처리해야할 일을 어떻게든 끝내고, 구글 검색해 VBA 기능 중 Find, FindNext 기능을 이용해 좀 더 빠르게 코드를 수정했습니다.

Find, FindNext 기능은 엑셀 기본 기능 중 찾기 기능입니다.

6시간 30분 실행된 같은 데이터를 대상으로 실행해 보니 280초 정도 걸려 처리되었습니다.

Public Sub 일치항목확인_FindData()
    ' 두 시트 사이에 일치하는 항목을 찾는 방법 개선판
    ' Find FindNext 기능 이용
    
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    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
                시작셀 = 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 <> 시작셀
            End If
        End If
        
        DoEvents
    Next i
    
    Application.ScreenUpdating = True
    
    Beep
    MsgBox "총 " & format(timer - 시작시간, "#,##0") & "초 소요"
End Sub

두번째 코드에는 반복해서 조회했나를 확인하는 메모를 입력하는 부분이 없었는데, 요구사항에서 필요없다는 이야기가 있어 기능을 제거했습니다.

 

중복신청 여부는 다른 형태로 구현했는데, 이걸 제외하고 VBA를 작성하고 보니 엑셀 기본 기능인 조건부서식에 COUNTIFS 함수를 이용해 동일여부 확인으로 구현할 수 있겠다는 생각이 들었습니다.

 

조건부서식에 수식으로 조건식을 작성했습니다.

=COUNTIFS(회원목록성명범위,신청자성명첫셀,회원목록생년월일범위,신청자생년월일첫셀)>1

조건부서식으로 처리하니 2초 이내에 동일여부 확인이 되었습니다.

조건부서식은 다른 파일에 있는 값을 대상으로는 처리되지 않아 회원 목록 파일에 있던 데이터를 신청자 파일에 시트 복사해 실행했습니다.

 

VBA를 이용하다보면 꼭 VBA로 문제를 해결하려는 속성이 있는데, 엑셀 기본 기능을 이용하면 휠씬 쉽고 빠르게 문제해결할 수 있는 경우가 많습니다.

엑셀을 배워야 할 이유 중 하나인거죠.

---

몇 개 파일을 처리하고 이메일로 처리결과를 확인하라고 보냈더니, 밤 12시쯤 연락와서 '죽을 것 같다'고 하며 중복신청자를 아예 제외해 달라고 요청을 해 왔습니다.

 

중복 신청의 경우 프로그램으로는 표시하고 사람이 수정하려고 코딩했었는데, 아예 빼 달라는 것이죠.

 

중복신청자 확인도 조건부서식으로 구현했습니다.

 

신청자 파일에서 조건부서식에 수식 조건으로 COUNTIFS 함수를 이용해 넣고 실행했습니다.

그런 다음 VBA로 신청확정 파일로 데이터를 넘기는 처리를 코딩했습니다.

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, 1)) '가족원수 확인
        
        For j = 0 To 인원수 - 1
            
            If Range("J" & (i + j)).Interior.ColorIndex <> 19 Or _
                Range("B" & (i + j)).Interior.Color = 16772300 Then ' 존재하지 않는 경우와 중복여부체크
                체크 = False
                Exit For
            End If
        Next j
        
        If 체크 Then
            원본시트.Range("B" & 출력).Value = Range("B" & i).Value
            원본시트.Range("G" & 출력).Value = Range("Q" & i).Value
            원본시트.Range("H" & 출력).Value = Range("E" & i).Value
            원본시트.Range("I" & 출력).Value = Range("G" & i).Value
            원본시트.Range("J" & 출력).Value = 인원수 * 50000
            원본시트.Range("V" & 출력).Value = Range("D" & 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

한 사람이 같은 가족 구성원을 한 번에 여러 명 신청할 수 있었는데, 가족 구성원 중 한 명이라도 회원 여부 확인되지 않으면 가족 구성원 전부가 등록되지 않도록 처리한 부분이 특이한 부분입니다.

 

그외에도 몇몇은 직접 수작업으로 바꾸기 기능을 여러 번 실행해서 바꾸는 작업을 해야 해서 하나하나 처리할 때마다 꽤 시간이 걸렸습니다.

 

그중 하나는 전화번호와 계좌번호 같이 숫자로 입력되는 부분이었습니다.

처음엔 최대한 원본 형태를 남겨 사람이 보기 쉽도록 구현한다고 바꾸기를 일일이 했었는데, 그냥 숫자만 남겨도 될 것 같아 VBA로 코딩했습니다.

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

실행할 땐 Call 명령문으로 불러서 실행합니다.

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

처음엔 코드 안에서 호출하는 걸로 생각해서 프로시저로 구현했는데, 그냥 사용자정의함수가 더 쉽게 여러 항목에 적용할 수 있다고 생각해서 다시 구현했습니다.

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

---

일단 이번 주 작업은 여기까지인데, 다음 주와 그 다음 주에 추가 접수가 있어 이미 신청된 사람을 구분하는 코드를 다시 만들어야 합니다.

 

처음에 생각할 땐 잘 구현되지 않거나 너무 비효율적인 부분이 있었는데, 궁리해 보니 더 좋은 방법을 찾게 됩니다.

 

이게 프로그래밍의 묘미입니다.

 

---

아직 해결되지 않은 일들이 많이 생겼습니다.

 

당장 급한 부분을 처리해 넘겼는데, 문제 생긴 부분이 생각하지도 못했던 부분이었습니다.

 

신청할 때 신청자가 본인 뿐만아니라 가족들도 같이 신청을 하는데, 틀리게 가족수를 입력했을 때 확인하지 않고 넘어가는 문제입니다.

이 부분 때문에 정상적으로 입력한 신청자도 제대로 확인되지 않는 문제가 있는거죠.

일단 잘못 입력된 부분을 찾고, 오류가 나지 않도록 수정하는 처리를 해야 했습니다.

당장 처리해야할 작업이 있어 오류 수정은 나중에 처리하고, 잘못 입력된 부분이라도 찾아 보시하는 코드를 만들었습니다.

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

신청자가 가족수를 입력할 때 1부터 9 사이라고 전제하고 처리했었는데, 10명 이상, 즉 두자리로 입력한 경우에는 경고 표시를 하도록 만드는 코드도 추가해서 구현했습니다.

 

일단 잘못 입력한 경우가 파일마다 1~30건 정도라 오류를 수정하는 부분은 사람이 직접 하는 걸로 일단 구현합니다. ^^;

 

또 이왕 손댄 김에 잘못 입력된 금융기관명을 일일이 바꾸기 기능으로 수정했던 부분을 코딩으로 작성했습니다.

완전한 해결책은 되지 못하지만 최소한 바꾸기를 100번 정도는 덜 하게 될 겁니다.

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

잘못 입력된 형태가 더 생기면 변환 시트에 추가로 등록하기만 하면 다음엔 그 부분이 적용되도록 구현해 둔 것이 맘에 듭니다.

지금 고생해도 점점 쉬워지는게 좋죠.

 

아직 끝나지 않았습니다. ^^

 

---

또 연락이 와서 급하게 처리할 일이 생겼습니다.

 

중복입금자 처리 문제였는데, 문제를 해결하다 보니 가족구성원이 11명인 데이터가 눈에 띄었습니다.

가족구성원은 한자리 숫자라고만 설정하고 처리했는데, 다행히 11명이라 1명씩 11번 처리가 되어 데이터가 잘못된 것은 아니었습니다.

 

가족구성원이 아무리 많아도 처리될 수 있도록 수정하고, 생년월이이 형식에 맞지 않게 입력되면 문제가 생겼는데, 이것도 같이 조건 처리했습니다.

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)).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

너무 많이 수정 작업을 해서 뭐가 원본 작업 파일인지도 이제 헤까릴 정도라 이번주 중복 처리할 때 특히 주의해야 합니다.

 

---

또 한가지 수정작업을 했습니다.

 

Range.Interior 개체를 사용하는 부분을 Range.DisplayFormat.Interior 개체를 사용하도록 수정했습니다.

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

https://hantip.tistory.com/entry/RangeInterior-%EA%B0%9C%EC%B2%B4%EC%99%80-RangeDisplayFormatInterior-%EA%B0%9C%EC%B2%B4

Range.Interior 개체와 Range.DisplayFormat.Interior 개체

이 코드 덕분에 조건부서식으로 채우기색 지정한 뒤 다시 색 필터 적용해 색을 한 번 더 입히는 수작업은 하지 않아도 됩니다.

조금씩이나마 개선되니 다행이죠. ^^

 

---

또 하루가 지났습니다.

 

원래는 주간 단위로 4번 접수 받아 하루씩만 작업하면 될 일인줄 알았는데, 계속 요청이 와서 처리할 일이 많습니다.

 

첫번째 문제는 입력 폼을 정확히 하지 않아 잘못입력된 데이터가 너무 많습니다.

이 데이터를 정형화 하는데 코딩으로 처리되야 하는 부분도 있지만 수작업이 많은 시간을 뺐습니다.

 

두번째는 이것 또한 입력 폼 문제이긴한데 중복신청된 경우가 많습니다.

같은 형태로 반복 신청한 경우도 있고, 가족까지 같이 신청하도록 된 것이라 처음엔 자기만, 두번짼 가족도 포함해서 등등

이것도 코딩으로 안되는 부분이 있어 또 시간을 뺐죠.

 

일단 첫 주 신청작업이 마무리 되고 처리되어 실처리자 명단과 신청자를 비교해 가공하는 작업을 했습니다.

실처리자 명단을 이용해 다음주 신청자 중 이미 처리된 신청자는 제외하는 작업을 해야하기 때문이죠.

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, 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

                    'Exit Do
                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 Or _
            sht1.Range("F" & 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

신청자 파일 35,000건, 원본 파일 43,000건 정도일 때 모든 신청자에 대해 원본 파일에서 검색에 표시하는 작업을 하니 20분 정도 걸리는 작업입니다.

 

다루는 데이터 개수가 적은데 비해 작업 시간이 이렇게 많이 걸리는 이유는 알고리즘이 나쁘기 때문이겠죠.

 

여유가 생기면 다시 살펴보자 싶은데, 막상 일 마치고 나면 다시 쳐다보지 않게 됩니다.

계속 해야할 일도 아니고 귀찮기 때문이기도 하기 때문이죠.

 

아직 마무리 되지 않았으니 계속 추가합니다.

 

참고로 구분선 중 실선은 날짜 변경이고, 점선으로 구분한 것은 같은 날 입니다.