각 셀 내에서 중복단어가 있을 경우 처음 나온 단어를 제외하고 뒤에 나오는 중복되는 모든 단어를 삭제하는 기능. 알아보기 쉽도록 중복되어 삭제될 단어는 빨간색으로 표시하였다. 배열의 split, filter, join 기능을 모두 사용함.
매크로 실행 전 매크로 실행 후 결과
Option Explicit
Sub remove_Duplicate_Word_Each_Cell()
Dim rngAll As Range '전체 영역을 넣을 변수
Dim rngC As Range '각 셀을 순환할 변수
Dim varTemp '전체 단어를 넣을 배열변수
Dim i As Integer '반복구문에 사용할 변수
Dim varR '필터링한 결과 넣을 배열변수
Dim str As String '치환할 단어 넣을 변수
Dim j As Integer '반복구문에 사용할 변수
Application.ScreenUpdating = False '화면 업데이트 (일시)중단
Columns(1).SpecialCells(2).Copy Cells(1, 2) '1열 문자만을 2열에 복사
Set rngAll = Range("B1", Cells(Rows.Count, "B").End(3)) '전체 영역을 변수에 넣음
For Each rngC In rngAll '전체영역 각 셀을 순환
varTemp = Split(rngC, " ") '각 셀을 구분자(공백)로 나누어 배열에
For i = LBound(varTemp) To UBound(varTemp) '배열 크기만큼 반복
varR = Filter(varTemp, varTemp(i), True, vbBinaryCompare)
'배열내 각 단어를 참(동일) 값으로 필터하여 배열에 넣음
If UBound(varR) > 0 Then '배열에 2개 이상의 값이 남으면(중복)
str = varTemp(i) '중복 값을 변수에 넣어둠
varTemp(i) = "<<>>" '(중복 없는 임의의)특수문자로 1단어를 치환
For j = LBound(varTemp) To UBound(varTemp) '배열 크기만큼 반복
If varTemp(j) = str Then '배열내 단어가 중복단어면
varTemp(j) = "" '중복 단어를 삭제
End If
Next j
rngC = Join(varTemp) '중복 제거한 단어를 합침
rngC.Replace "<<>>", str '치환한 단어 복원
varTemp = Split(rngC, " ") '중복 제거한 단어를 다시 배열에 넣음
End If
Next i
Next rngC
Columns("B").SpecialCells(2).Replace " ", " " '공백 2개를 1개로 바꿈
Set rngAll = Nothing '개체 변수 초기화
End Sub
첨부파일
댓글