엑셀 VBA #119 / Dictionary 개체_실무 [VBA]

엑셀 VBA #119 / Dictionary 개체_실무 [VBA]

Range("A1").CurrentRegion.Copy Range("D1")
Range("D1").CurrentRegion.RemoveDuplicates Array(1, 2), xlYes
'array(1,2) : 제거할 인수가 CurrnetRegion영역의 1열과, 2열!!!
'xlYest 영역에 머리글이 포함되어 있음

결과값

 

 

최종코딩

Sub Pdictionary()
    Dim dict As New Scripting.Dictionary
    Dim rngS As Range, c As Range
    Dim i As Long
    Dim s As Variant
    
    Application.ScreenUpdating = False
    
    Columns("D:I").Clear
    Range("A1").CurrentRegion.Copy Range("D1")
    Range("D1").CurrentRegion.RemoveDuplicates Array(1, 2), xlYes
    'array(1,2) : 제거할 인수가 CurrnetRegion영역의 1열과, 2열!!!
    'xlYest 영역에 머리글이 포함되어 있음
    
    Set rngS = Range("D2", Cells(Rows.Count, "D").End(xlUp))
    
    For Each c In rngS
        If dict.Exists(c.Value) Then
            dict(c.Value) = dict(c.Value) & "," & c.Offset(, 1)
        Else
            dict.Add c.Value, c.Offset(, 1)  '딕셔너리명.Add Key값,Item값
            'dict 딕셔너리에 c의 key값과,c에서 1열 떨어진(offset(,1)) item값을 넣어라
        End If
    Next
    
Set rngt = Range("G1")

For i = 0 To UBound(dict.Items)
    s = Split(dict.Items(i), ",")  '딕셔너리 각각의 item의 값이 ","로 분리된 값을 임의의 배열방 s에 저장한다.
    rngt.Offset(0, i) = dict.Keys(i)
    rngt.Offset(1, i).Resize(UBound(s) + 1, 1).Value = Application.Transpose(s)   
Next

Columns("C:E").Delete
 Application.ScreenUpdating = True
  
  Set dict = Nothing
  Set Rng = Nothing
  Set c = Nothing
  Set rngS = Nothing
  Set rngt = Nothing
End Sub

vba#119.xlsm

0.02MB

엑셀 VBA #65 / 질문 답변(데이터 취합) [VBA]    RemoveDuplicates (Array(1,2)

엑셀 VBA #47 / 중복데이터 처리_1 [VBA]- Removeduplicates. 고급필터. New Collection

 

https://www.youtube.com/watch?v=SrOrTwZuxXA&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=121

ㅇ