[& Chronicle] Dictionary 중복값 추려내며 배열에 담기

Dictionary를 이용하여 중복값 추려내며 데이터를 배열에 담아내는 짧은 코드

수식은 Chronicle님의 블로그에 - http://blog.naver.com/asaph16/220627965891 (감탄)

Sub Macro()
 
    Dim D As Object
    Dim vCar, vMsg$()
    Dim i%, j%, intC%
    Dim rngMsg As Range
    
    vCar = Range("C5", Cells(Rows.Count, "D").End(3))   '이름 및 차량 범위
    Set D = CreateObject("Scripting.Dictionary")    '딕셔너리 선언
    Set rngMsg = Range("F5")    '메시지 출력 셀
    
    If LenB(rngMsg) Then rngMsg.CurrentRegion.ClearContents '기존 메시지 삭제
    
    For i = 1 To UBound(vCar, 1)    '사원명 순환
    
        If Not D.Exists(vCar(i, 1)) Then    '사원명이 없으면 배열에 이름 및 차량을 넣음
            ReDim Preserve vMsg(1, j)
            D.Add vCar(i, 1), j
            vMsg(0, j) = vCar(i, 1)
            vMsg(1, j) = vCar(i, 2)
            j = j + 1
        
        Else    '사원명이 있으면 이름에 차량을 삽입
            intC = D.Item(vCar(i, 1))
            vMsg(1, intC) = vMsg(1, intC) & ", " & vCar(i, 2)
            
        End If
        
    Next i
    
    With rngMsg '메시지 출력
    
        For i = 0 To UBound(vMsg, 2)
        
            .Offset(i) = vMsg(0, i) & "님의 차량은 " & vMsg(1, i) & "입니다"
            
        Next i
        
    End With
End Sub

퇴근하자젭알.xlsm