[땡큐엑셀vba & 엑셀매크로] 불량번호 삭제하기

삭제전

 

삭제후

 

'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=281796775
'안녕하세요ㅜ. . 몇천개의 전화번호 에서 따로 받은
'불량 전화번호목록을 이용해서 찾아내 삭제해야하는데요... 도무지 방법을 알수가없어 질문드립니다ㅜ 도와주세요!
'A열에 쭈욱 번호가있으면 B열에 불량번호가 몇십개있는 상황이구. A열에 그 불량번호가 섞여있는 상황입니다. 찾아내서 삭제하는방법이 있을까요?


'A열에 전화번호,B열에 불량번호가 있다는 가정
'[A1]전화번호       [B1]불량번호
'[A2]010-1111-2222  [B2]010-1111-2222
'[A3].....          [B3]......
'

 

 

'
'source by 땡큐엑셀vba & 엑셀매크로
'
'1. 불량번호 리스트를 사전에 담은후
'2. 전화번호를 루프돌며 불량번호 사전에 있는지 비교
'3. 있으면 삭제하고 없으면 그대로 표시
Sub 불량번호삭제()

    Dim D As Object
    
    '화면갱신 멈춤
    Application.ScreenUpdating = False
    
    
    '1. 불량번호 루프돌며 사전에 기록
    v불량번호 = Range("B2", Cells(Rows.Count, "B").End(xlUp)) '불량번호 범위
    Set D = CreateObject("Scripting.Dictionary")    '딕셔너리 선언
    
    For i = 1 To UBound(v불량번호, 1)
    
        If Not D.exists(v불량번호(i, 1)) Then
        
            D.Add v불량번호(i, 1), 1
            
        Else
        
            D.Item(v불량번호(i, 1)) = D.Item(v불량번호(i, 1)) + 1
            
        End If
    
    Next
    
    
    '2. 전화번호 루프돌며 사전에 기록
    '동일한 번호일경우 카운트 증가 & 삭제
    v번호 = Range("A2", Cells(Rows.Count, "A").End(xlUp)) '전화번호 범위
    For i = 1 To UBound(v번호, 1)
    
        '없는 번호일경우 사전에 추가
        If Not D.exists(v번호(i, 1)) Then
            D.Add v번호(i, 1), 1
        Else '있는번호의 경우 카운트 증가
            D(v번호(i, 1)) = D(v번호(i, 1)) + 1
            Range("A2")(i, 1) = "" '공백으로 처리
        End If
    
    Next
    
    '화면갱신 재개
    Application.ScreenUpdating = True
    
    
    MsgBox "완료되었습니다.", vbInformation, "땡큐엑셀vba & 엑셀매크로"
    
End Sub

 

불량전화번호지우기-Dictionary_Exists_Add_UBound-땡큐엑셀vba.xlsm

0.05MB