728x90

셀의 전체 구간이 아니라 부분 구간을 설정하고 그 구간에 중복되는 셀을 제거하는 VBA 코드를 만들어야 했다.

F8키를 눌러서 계속 검증 작업을 해보는데 문제가 생긴다.


확인결과 RemoveDuplicates 함수가 문제를 일으킨다.

이 함수는 머리글이 있고 전체에서 중복을 제거할 때 유용한가 보다.

중복제거를 제대로 못하는 경우도 있는 거 같아서 혹시나 하고 Sort 를 해서 중복을 제거하고 다시 원상태로 돌리는 작업을 진행했다.

그런데 전체구간의 중복을 체크하다보니 원하지 않는 셀이 중복이라고 삭제되는 경우가 생겨버렸다.

이걸 해결하려고 구간을 설정하고 반복해서 중복을 제거하라고 했던 것인데 잘 안되니까

생고생 끝에 다음 코드를 만들었다.


rngC 이 한행이 변하면서 구간내에서 6개의 셀을 다시 범위 설정해서 계속해서 반복적으로 돌려가면서 작업을 하는 것이다.


Sub 중복제거()
    Dim sTotal, eTotal As Long
    Dim i, n, k As Long
    Dim rngC, rngT As Range
    Dim rngAll As Range
    Dim rngDB As Range
   
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    sTotal = Cells(Rows.Count, "A").End(3).Row
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
    For Each rngC In rngAll
        Set rngDB = Range(rngC, rngC.Offset(5))
        For Each rngT In rngDB
             i = i + 1
            rngT.Offset(, 1) = i
        Next rngT
        Range(rngC, rngC.Offset(5, 1)).Sort key1:=rngDB, order1:=1, Header:=xlNo
        For n = rngC.Offset(5).Row To rngC.Row Step -1
            If Cells(n, 1) = Cells(n - 1, 1) Then
                Cells(n, 1).EntireRow.Delete
                k = k + 1
            End If
        Next n
        Range(rngC, rngC.Offset(5 - k, 1)).Sort key1:=Range(rngC.Offset(0, 1), rngC.Offset(5 - k, 1)), order1:=1, Header:=xlNo
        Range(rngC.Offset(, 1), rngC.Offset(, 1).End(4)).ClearContents
                     
        i = 0   '// 초기화
        k = 0
   '// 초기화   

    Next rngC
   
    eTotal = Cells(Rows.Count, "A").End(3).Row
    MsgBox sTotal - eTotal & " 개 제거"

End Sub.

728x90
블로그 이미지

Link2Me

,