같은 내용을 묶어서 합치기3(중복된 항목 제거, 정렬, VBA)

안녕하세요.

 

출판사별 분야 목록을 구하는 질문을 해결하는데, 이렇게 여러 번 처리해야 할 줄 처음엔 몰랐습니다.

몇가지 방법으로 문제를 해결하긴 했지만 미흡한 부분이 있고, 마지막 VBA로 처리한 방법은 원하는 결과를 정확하게 구하긴 했지만, 중첩된 반복문으로 구현되어 있어 처리해야 할 목록 개수가 많아지면 생각한 것보다 휠씬 오랜 시간이 걸릴 수 있습니다.

 

2020.06.24 - 같은 내용을 묶어서 합치기(피벗 테이블, MATCH, TEXTJOIN)

같은 내용을 묶어서 합치기(피벗 테이블, MATCH, TEXTJOIN)

 

2020.06.25 - 같은 내용을 묶어서 합치기(VBA)

같은 내용을 묶어서 합치기(VBA)

 

2020.06.25 - 같은 내용을 묶어서 합치기2(배열)

같은 내용을 묶어서 합치기2(배열)

 

그래서 좀 더 나은 방법이 없을까 생각해 봤는데, 결국 엑셀 기본 기능으로 처리할 수 있겠다는 생각이 들었습니다.

 

아이디어는 이렇습니다.

 

현재 데이터를 새로운 시트에 복사한 다음 [중복된 항목 제거] 기능으로 출판사와 분야가 같은 항목을 없애고, 출판사 필드를 기준으로 [정렬]하는 겁니다. 그런 다음 이렇게 처리된 데이터를 출판사별 분야를 묶어 원하는 결과를 구하고, 작업을 위해 만든 시트는 삭제해서 마무리를 하는 방법입니다.

 

이 모든 작업을 VBA로 작성해 한 번에 실행하도록 만듭니다.

 

실습 파일 다운로드

같은 내용을 묶어서 합치기3_실습.xlsm

0.01MB

완성 파일 다운로드

같은 내용을 묶어서 합치기3_완성.xlsm

0.02MB

 

현재 시트를 복사하고, 중복된 항목을 제거한 뒤 정렬하는 작업을 VBA로 어떻게 나타낼 지 코드를 확인하기 위해 매크로를 기록해 봅니다.

 

매크로를 기록하면 만들어진 코드를 그대로 VBA로 쓸 수는 없겠지만 어떤 개체를 어떻게 써야 할지 예시를 볼 수 있습니다.

 

[개발 도구] - [매크로 기록]을 선택합니다.

[매크로 기록] 대화상자에서 [매크로 이름]은 기본 값 그대로 사용합니다.

[확인]을 누릅니다.

[시트] 탭에서 마우스 오른쪽 단추를 눌러 메뉴를 표시하고 [이동/복사]를 선택합니다.

[복사본 만들기]에 체크한 뒤 [확인]을 누릅니다.

시트가 복사되었습니다.

[데이터] - [중복된 항목 제거]를 선택합니다.

[중복 값 제거] 대화상자에서 '도서명' 열은 체크 해제하고 [확인]을 누릅니다.

출판사와 분야가 같은 것은 중복으로 생각하고 제거하기 위해 도서명 열을 조건에서 해제한 것입니다.

중복된 항목이 제거되어 고유한 값만 남았습니다.

출판사 기준으로 정렬하기 위해 [데이터] - [텍스트 오름차순 정렬]을 누릅니다.

매크로를 만드는 필요한 작업은 다 했으니 [개발 도구] - [기록 중지]를 누릅니다.

 

만들어진 코드를 확인하기 위해 <Alt + F11>키를 눌러 VBE를 실행합니다.

왼쪽 [프로젝트 탐색기]에서 [모듈] 앞 +를 눌러 확장하고 'Module1'을 더블클릭합니다.

현재 시트 앞에 새 시트를 복사합니다.

Sheets("Sheet1").Copy Before:=Sheets(1)

데이터가 입력된 범위에서 1, 3열을 기준으로 중복된 항목을 제거합니다.

ActiveSheet.Range("$A$1:$C$9").RemoveDuplicates Columns:=Array(1, 3), Header _
	:=xlYes

A열을 기준으로 정렬합니다.

ActiveWorkbook.Worksheets("Sheet1 (2)").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1 (2)").Sort.SortFields.Add2 Key:=Range("A1") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Sheet1 (2)").Sort
    .SetRange Range("A2:C7")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

매크로 코드 중 시트명을 직접 적은 부분과 셀 주소를 직접 적은 부분은 상황에 따라 변경되도록 코드를 수정해야 합니다.

시트명은 새 시트를 삽입한 뒤 특정 시트명으로 코드에서 정하면 됩니다.

새로 삽입된 시트명을 'work'라고 정합니다.

Sheets("Sheet1").Copy Before:=Sheets(1)
Sheets(1).Name = "work"

중복된 항목 제거 부분 코드에서 셀 주소 중 시작 셀인 A1과 끝 열인 C열은 고정이지만 행번호 9가 입력된 내용에 따라 달라집니다.

그래서 입력된 데이터의 마지막 행 번호를 알아내는 코드를 작성합니다.

[A1] 셀에서 <Ctrl + 화살표아래쪽>키를 누른 동작을 코드로 작성하고, 그 위치의 행 번호를 구합니다.

마지막행 = Range("A1").End(xlDown).Row
ActiveSheet.Range("$A$1:$C$" & 마지막행).RemoveDuplicates Columns:=Array(1, 3), Header _
    :=xlYes

중복된 항목을 제거하고 나면 마지막 행 번호가 달라지기 때문에 다시 마지막 행을 구하는 코드가 필요합니다.

그리고 시트명과 함께 구해진 마지막 행 번호를 정렬하는 코드에 적용합니다.

마지막행 = Range("A1").End(xlDown).Row
ActiveWorkbook.Worksheets("work").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("work").Sort.SortFields.Add2 Key:=Range("A1") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("work").Sort
    .SetRange Range("A2:C" & 마지막행)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

 

코드를 다 수정했으니 제대로 동작하는지 확인해 봐야 합니다.

 

새로 삽입된 시트를 삭제합니다.

엑셀 창으로 돌아가서 시트 탭에서 새로 삽입된 시트에서 마우스 오른쪽 단추를 눌러 [삭제]를 선택합니다.

삭제 확인 대화상자에서 [삭제]를 누릅니다.

다시 VBE 창으로 돌아가서 지금까지 수정한 내용을 저장합니다.

 

매크로를 실행하기 전에 미리 저장을 해 두는게 좋습니다.

매크로가 실행되다 오류가 발생하면 엑셀을 강제로 종료해 매크로를 실행하기 전에 저장하지 않은 코드가 모두 복구할 수 없는 경우가 생길 수 있기 때문입니다.

 

<F5>키를 눌러 실행합니다.

제대로 실행되었습니다.

 

실행했는데, 오류가 난다면 작성한 코드를 처음부터 찬찬히 살펴봐야 합니다.

오류가 나는 이유는 아주 다양합니다.

오타는 물론이고 띄어쓰기가 잘못되었거나 순서를 바꿔 적었거나 아주 사소한 것 하나라도 다른 부분이 있으면 동작하지 않을 수 있습니다.

오류가 생겨서 찾아 고쳐야 할 때는 꼭 '이상 없겠지' 하는 부분에 이상이 있습니다.

오류가 생겼을 때 원인을 찾고, 문제를 해결하는 방법도 꼭 배워야 할 부분입니다.

 

현재까지 만들어진 코드 전체입니다.

Sub 매크로1()
'
' 매크로1 매크로
'


    Sheets("Sheet1").Copy Before:=Sheets(1)
    Sheets(1).Name = "work"
    
    마지막행 = Range("A1").End(xlDown).Row
    ActiveSheet.Range("$A$1:$C$" & 마지막행).RemoveDuplicates Columns:=Array(1, 3), Header _
        :=xlYes

    마지막행 = Range("A1").End(xlDown).Row
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("work").Sort
        .SetRange Range("A2:C" & 마지막행)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

이제 출판사별로 묶어 분야를 합쳐 보이는 작업이 필요합니다.

합칠 내용이 들어 있는 시트의 이름은 work이고, 결과를 나타낼 시트 이름은 Sheet1입니다.

셀 주소를 적을 때 시트명까지 같이 적으면 원하는 시트에 셀을 지정해 내용을 나타낼 수 있습니다.

Sheet1 시트 [E1] 셀과 [F1] 셀에 '출판사', '분야' 필드 제목을 출력합니다.

Sub 매크로1()
'
' 매크로1 매크로
'


    Sheets("Sheet1").Copy Before:=Sheets(1)
    Sheets(1).Name = "work"
    
    마지막행 = Range("A1").End(xlDown).Row
    ActiveSheet.Range("$A$1:$C$" & 마지막행).RemoveDuplicates Columns:=Array(1, 3), Header _
        :=xlYes

    마지막행 = Range("A1").End(xlDown).Row
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("work").Sort
        .SetRange Range("A2:C" & 마지막행)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Sheet1").Range("E1").Value = "출판사"
    Sheets("Sheet1").Range("F1").Value = "분야"
    
End Sub

work 시트의 [A2] 셀부터 마지막 행까지 순서대로 실행되어 가도록 변수 i를 설정합니다.

또 Sheet1 시트 E열과 F열에 출력할 위치를 결정하기 위해 변수 j를 설정합니다.

출판사를 기준으로 정렬되어 있어 위에서 아래로 하나씩 출력할 때 출판사명이 바뀌었는지 확인하기 위해 첫번째 출판사명을 담아둘 변수 출판사를 설정하고, 첫번째 출판사명을 넣습니다.

 

순서대로 정렬되어 있는 데이터에서 처음부터 차례대로 비교할 때 첫번째 값을 일단 변수에 넣어두고 각 데이터를 차례대로 비교할 때 변수에 저장해 둔 값과 다르면 조건문을 작성해 필요한 동작을 하고, 다시 비교할 값을 넣어 두는 변수에 현재 값을 넣어 다음 데이터와 비교하는 이 방법은 흔히 사용되는 알고리즘입니다.

Sub 매크로1()
'
' 매크로1 매크로
'


    Sheets("Sheet1").Copy Before:=Sheets(1)
    Sheets(1).Name = "work"
    
    마지막행 = Range("A1").End(xlDown).Row
    ActiveSheet.Range("$A$1:$C$" & 마지막행).RemoveDuplicates Columns:=Array(1, 3), Header _
        :=xlYes

    마지막행 = Range("A1").End(xlDown).Row
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("work").Sort
        .SetRange Range("A2:C" & 마지막행)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Sheet1").Range("E1").Value = "출판사"
    Sheets("Sheet1").Range("F1").Value = "분야"
    
    j = 2
    출판사명 = Sheets("work").Range("A2").Value
    
    For i = 2 To 마지막행
    
    Next i
    
End Sub

For~Next문 안에 변수 출판사명에 저장된 값과 현재 처리할 출판사명이 다르면 출력위치 변수 j의 값을 1 증가시키고 변수 출판사명에 현재 처리할 출판사명을 넣습니다.

그전에 첫번째 출판사명을 출력하는 코드를 For~Next문 앞에 적습니다.

Sub 매크로1()
'
' 매크로1 매크로
'


    Sheets("Sheet1").Copy Before:=Sheets(1)
    Sheets(1).Name = "work"
    
    마지막행 = Range("A1").End(xlDown).Row
    ActiveSheet.Range("$A$1:$C$" & 마지막행).RemoveDuplicates Columns:=Array(1, 3), Header _
        :=xlYes

    마지막행 = Range("A1").End(xlDown).Row
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("work").Sort
        .SetRange Range("A2:C" & 마지막행)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Sheet1").Range("E1").Value = "출판사"
    Sheets("Sheet1").Range("F1").Value = "분야"
    
    j = 2
    출판사명 = Sheets("work").Range("A2").Value
    
    Sheets("Sheet1").Range("E2").Value = Sheets("work").Range("A2").Value
    
    For i = 2 To 마지막행
        If 출판사명 <> Sheets("work").Range("A" & i).Value Then
            j = j + 1
            
            출판사명 = Sheets("work").Range("A" & i).Value
        End If

    Next i
    
End Sub

If문 안에서 출판사명을 출력하는 코드를 작성하고, If문 밖에서 분야를 앞에 출력된 분야 뒤에 이어서 출력하도록 작성합니다.

Sub 매크로1()
'
' 매크로1 매크로
'


    Sheets("Sheet1").Copy Before:=Sheets(1)
    Sheets(1).Name = "work"
    
    마지막행 = Range("A1").End(xlDown).Row
    ActiveSheet.Range("$A$1:$C$" & 마지막행).RemoveDuplicates Columns:=Array(1, 3), Header _
        :=xlYes

    마지막행 = Range("A1").End(xlDown).Row
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("work").Sort
        .SetRange Range("A2:C" & 마지막행)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Sheet1").Range("E1").Value = "출판사"
    Sheets("Sheet1").Range("F1").Value = "분야"
    
    j = 2
    출판사명 = Sheets("work").Range("A2").Value
    
    Sheets("Sheet1").Range("E2").Value = Sheets("work").Range("A2").Value
    
    For i = 2 To 마지막행
        If 출판사명 <> Sheets("work").Range("A" & i).Value Then
            j = j + 1
            
            Sheets("Sheet1").Range("E" & j).Value = Sheets("work").Range("A" & i).Value
            출판사명 = Sheets("work").Range("A" & i).Value
        End If
        
        Sheets("Sheet1").Range("F" & j).Value = Sheets("Sheet1").Range("F" & j).Value & Sheets("work").Range("C" & i).Value & ", "
    Next i
    
End Sub

마지막으로 분야를 출력한 내용 끝에 필요 없는 ', '(쉼표와 빈칸)을 삭제하는 코드를 작성합니다.

출력된 내용의 마지막 행은 변수 j의 값까지 입니다.

Sub 매크로1()
'
' 매크로1 매크로
'


    Sheets("Sheet1").Copy Before:=Sheets(1)
    Sheets(1).Name = "work"
    
    마지막행 = Range("A1").End(xlDown).Row
    ActiveSheet.Range("$A$1:$C$" & 마지막행).RemoveDuplicates Columns:=Array(1, 3), Header _
        :=xlYes

    마지막행 = Range("A1").End(xlDown).Row
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("work").Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("work").Sort
        .SetRange Range("A2:C" & 마지막행)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Sheet1").Range("E1").Value = "출판사"
    Sheets("Sheet1").Range("F1").Value = "분야"
    
    j = 2
    출판사명 = Sheets("work").Range("A2").Value
    
    Sheets("Sheet1").Range("E2").Value = Sheets("work").Range("A2").Value
    
    For i = 2 To 마지막행
        If 출판사명 <> Sheets("work").Range("A" & i).Value Then
            j = j + 1
            
            Sheets("Sheet1").Range("E" & j).Value = Sheets("work").Range("A" & i).Value
            출판사명 = Sheets("work").Range("A" & i).Value
        End If
        
        Sheets("Sheet1").Range("F" & j).Value = Sheets("Sheet1").Range("F" & j).Value & Sheets("work").Range("C" & i).Value & ", "
    Next i
    
    For i = 2 To j
        Sheets("Sheet1").Range("F" & i).Value = Left(Sheets("Sheet1").Range("F" & i).Value, Len(Sheets("Sheet1").Range("F" & i).Value) - 2)
    Next i
    
End Sub

 

여기까지 작성한 뒤 저장하고, 다시 한번 제대로 실행되는지 <F5>키를 눌러 실행합니다.

Sheet1 시트를 선택해 결과를 확인합니다.

마지막으로 작업용으로 사용한 work 시트를 삭제하면 마무리 됩니다.

 

그 전에 Sheet1 시트와 work 시트를 여러 번 적어야 해서 코드가 길게  표시되는데, 시트를 나타내는 변수를 써서 코드를 줄이도록 하겠습니다.

이 작업은 코드가 실행되는 것엔 영향을 미치지 않고 코드를 보기 편하고 나중에 바꿀 일이 있을 때 쉽게 바꾸기 위한 작업입니다.

 

개체 변수를 선언하고 시트를 할당합니다.

Sub 매크로1()
'
' 매크로1 매크로
'

    Dim S1 As Object
    Dim S2 As Object
    
    Set S1 = Sheets("Sheet1")
    
    S1.Copy Before:=Sheets(1)
    Sheets(1).Name = "work"
    
    Set S2 = Sheets("work")
    
    마지막행 = S2.Range("A1").End(xlDown).Row
    ActiveSheet.Range("$A$1:$C$" & 마지막행).RemoveDuplicates Columns:=Array(1, 3), Header _
        :=xlYes

    마지막행 = S2.Range("A1").End(xlDown).Row
    ActiveWorkbook.Sheets("work").Sort.SortFields.Clear
    ActiveWorkbook.Sheets("work").Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Sheets("work").Sort
        .SetRange Range("A2:C" & 마지막행)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    S1.Range("E1").Value = "출판사"
    S1.Range("F1").Value = "분야"
    
    j = 2
    출판사명 = S2.Range("A2").Value
    
    S1.Range("E2").Value = S2.Range("A2").Value
    
    For i = 2 To 마지막행
        If 출판사명 <> S2.Range("A" & i).Value Then
            j = j + 1
            
            S1.Range("E" & j).Value = S2.Range("A" & i).Value
            출판사명 = S2.Range("A" & i).Value
        End If
        
        S1.Range("F" & j).Value = S1.Range("F" & j).Value & S2.Range("C" & i).Value & ", "
    Next i
    
    For i = 2 To j
        S1.Range("F" & i).Value = Left(S1.Range("F" & i).Value, Len(S1.Range("F" & i).Value) - 2)
    Next i
    
End Sub

마지막에 work 시트를 삭제하는 코드를 넣습니다.

 

그런데 시트 삭제 코드만 넣으면 '정말 지우시겠습니까?' 같은 경고창이 표시됩니다.

시트를 지우면 영구적인 삭제이므로 되돌릴 수 없습니다.

그래서 특별히 경고창으로 강조해서 표시하는 것입니다.

자동으로 실행되어야 하므로 경고창이 나타나지 않도록 작용하는 코드를 적고, 시트를 삭제한 뒤 다시 경고창이 표시되도록 설정하는 코드를 적습니다.

Sub 매크로1()
'
' 매크로1 매크로
'

    Dim S1 As Object
    Dim S2 As Object
    
    Set S1 = Sheets("Sheet1")
    
    S1.Copy Before:=Sheets(1)
    Sheets(1).Name = "work"
    
    Set S2 = Sheets("work")
    
    마지막행 = S2.Range("A1").End(xlDown).Row
    ActiveSheet.Range("$A$1:$C$" & 마지막행).RemoveDuplicates Columns:=Array(1, 3), Header _
        :=xlYes

    마지막행 = S2.Range("A1").End(xlDown).Row
    ActiveWorkbook.Sheets("work").Sort.SortFields.Clear
    ActiveWorkbook.Sheets("work").Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Sheets("work").Sort
        .SetRange Range("A2:C" & 마지막행)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    S1.Range("E1").Value = "출판사"
    S1.Range("F1").Value = "분야"
    
    j = 2
    출판사명 = S2.Range("A2").Value
    
    S1.Range("E2").Value = S2.Range("A2").Value
    
    For i = 2 To 마지막행
        If 출판사명 <> S2.Range("A" & i).Value Then
            j = j + 1
            
            S1.Range("E" & j).Value = S2.Range("A" & i).Value
            출판사명 = S2.Range("A" & i).Value
        End If
        
        S1.Range("F" & j).Value = S1.Range("F" & j).Value & S2.Range("C" & i).Value & ", "
    Next i
    
    For i = 2 To j
        S1.Range("F" & i).Value = Left(S1.Range("F" & i).Value, Len(S1.Range("F" & i).Value) - 2)
    Next i
    
    Application.DisplayAlerts = False
    S2.Delete
    Application.DisplayAlerts = True
End Sub

 

이렇게 해서 완성되었습니다.

 

중첩된 반복문 없이 작성되어 처리할 데이터가 많아도 큰 어려움 없이 빠르게 잘 동작하리라 기대합니다.

마지막 완성된 코드만 보지 말고 차근차근 순서대로 만들어져 가는 코드를 따라 가다 보면 의미를 파악할 수 있습니다.

 

필요하신 분께 도움이 되길 바라며 마치겠습니다.

수고하셨습니다.