Dictionary

고유값 추출과 배열 삽입 등 Dictionary를 사용한 예.

예제 파일에 텍스트의 셀서식이 회계로 돼있어서 약간 헷갈렸네.

거래처별 고유값을 추출하지 않아도 된다는 점은 함정.

그것도 모르고 고유값 추출...;;

Option Explicit
Sub Macro()
 
    Dim rngA As Range
    Dim rngK As Range
    Dim rnG As Range
    Dim X As Object
    Dim dicA As Variant
    Dim vObj As Variant
    Dim vDic() As String
    Dim i As Byte
    
    Application.ScreenUpdating = False
    
    'A열 K열 범위 설정
    Set X = CreateObject("Scripting.Dictionary")
    Set rngA = Range("A4", Cells(Rows.Count, "A").End(3))
    Set rngK = Range("K4", Cells(Rows.Count, "K").End(3))
    
    'A열과 K열의 고유값 추출 후 배열에 삽입
    For Each rnG In Union(rngA, rngK)
        If Not X.exists(rnG.Text) Then
            X.Add rnG.Text, CStr(rnG)
        End If
    Next rnG
    dicA = X.items
    
    'G열 기존자료 삭제 후 고유값 입력
    With Range("G4")
        Range(.Cells, .End(4)).ClearContents
    End With
    Range("G4").Resize(X.Count) = WorksheetFunction.Transpose(dicA)
    
    'A열과 G열 비교해서 A열에 없는 거래처명을 A열의 아래쪽에 입력
    For Each vObj In dicA
        If WorksheetFunction.CountIf(rngA, vObj) = 0 Then
            ReDim Preserve vDic(i)
            vDic(i) = vObj
            i = i + 1
        End If
    Next vObj
    
    On Error Resume Next
        Cells(Rows.Count, "A").End(3)(2).Resize(UBound(vDic) + 1) = WorksheetFunction.Transpose(vDic)
    On Error GoTo 0
    
    '배열 및 변수 초기화
    Erase vDic
    i = 0
    
    'K열과 G열 비교해서 A열에 없는 거래처명을 A열의 아래쪽에 입력
    For Each vObj In dicA
        If WorksheetFunction.CountIf(rngK, vObj) = 0 Then
            ReDim Preserve vDic(i)
            vDic(i) = vObj
            i = i + 1
        End If
    Next vObj
    
    On Error Resume Next
        Cells(Rows.Count, "K").End(3)(2).Resize(UBound(vDic) + 1) = WorksheetFunction.Transpose(vDic)
    On Error GoTo 0
    
    Application.ScreenUpdating = True
        
End Sub

통합 문서1.xlsm