셀의 전체 구간이 아니라 부분 구간을 설정하고 그 구간에 중복되는 셀을 제거하는 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.
'업무 능력 향상 > 엑셀 VBA 활용' 카테고리의 다른 글
[VBA] 다른 엑셀파일 내용 가져오기 (2) | 2015.05.26 |
---|---|
영화자막 하이픈 처리 (0) | 2015.05.24 |
다른 시트 자료를 SQL 로 가져오기 (0) | 2015.05.21 |
[VBA] 환율 파싱 (0) | 2015.05.18 |
[VBA] 다른 엑셀 또는 다른 시트에서 SQL 로 데이터 가져오기 (0) | 2015.05.15 |