엑셀 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 #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

ㅇ

엑셀 VBA #118 / Dictionary 개체_기본 [VBA]

[New Dictionary]
Dim dict As Oject
Set dict = CreateObject("scripting.dictionary")
위 두 문장으로 된 구문( Late Binding이라 함)을

아래 하나의 문장으로 된 구문( Early Binding이라 함)으로 할 수 있다.

Dim dict As New Scripting.Dictionary



1.구조 
Dictionary이름명. Add  Key  Item


2. 예시
dict.Add "사과",111
dict.Add "바나나",222
dict.Add "딸기",333

3. For ~ Next문에 적용

3.1. 기본
Dim dict As New Scripting.Dictionary
Dim i As Long

dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333

For i = 0 To 2
    Cells(i + 1, 1) = dict.Items(i)
Next

위 구문의 문제점은 Item 갯수가 아주 많은 경우에는 처리속도가 느려진다는 것이다..

그래서 Key  및 Item값을 워크시트에 한꺼번 뿌려줄 필요가 있다.

이것을 할 수 있는 방법이 '배열'이다.

3.1. 동적배열

Dim dict As New Scripting.Dictionary
Dim i As Long
Dim arr() As Variant    '동적배열 적용. arr()의 값 유형을 모르니 Variant로 한다.

dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333

For i = 0 To 2
    'Cells(i + 1, 1) = dict.Items(i)
    ReDim Preserve arr(i)   ' 동적배열 적용문으로 동적배열의 사이즈를 i값으로 재선언
    arr(i) = dict.Items(i)        'item(i)값을 arr방에 집어넣기!!!!
Next

이제는 arr방에 들어온 item(i)값을 시트에 뿌려보자

......

   arr(i) = dict.Items(i)
Next

range("A1:A3") =arr

메모리 상에서는 arr은 아래 그림처럼 가로로 담겨져 있다.

이를 A1:A3로 올바르게 뿌려지기 위해서는 Transpose함수를 아래처럼 적용해야 한다.

range("A1:A3") =Application.transpose(arr)

3.1.1. UBound & LBound

For~Next문에서 i의 마지막 값을 프로그램이 자동으로 지정할 수 있도록 해야한다. 하드코딩하는 방법을 바람직하지 않다.프로그램이 알아서 값을 지정할 수 있도록 하는 변수에는 UBound와 LBound가 있다.

For i = 0 To 2

For i = 0 To UBound(dict.Items)   

4. 최종 코드

Sub Pdictionary()

Dim dict As New Scripting.Dictionary
Dim i As Long
Dim arr() As Variant

dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333

For i = 0 To UBound(dict.Items)
    'Cells(i + 1, 1) = dict.Items(i)
    ReDim Preserve arr(i)
    arr(i) = dict.Items(i)
Next

Range("A1:A3") = Application.Transpose(arr)
 
End Sub

VBA - Dictionary(Late vs Early Binding) by 우노사설

https://www.youtube.com/watch?v=1yBE6MGkIA4&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=120

엑셀 VBA #49 / New Collection_버블정렬의 콜라보 [VBA]

Dim nc As New Collection
Dim rng As Range, c As Range
Dim a() As Variant
Dim i As Long

Set rng = Range("A1", Cells(Rows.Count, "A").End(xlUp))

'----------------------------
'고유목록 추출
'----------------------------
On Error Resume Next
For Each c In rng
    If Len(c) Then
        nc.Add Trim(c), CStr(Trim(c))
    End If
Next
On Error GoTo 0

'---------------------------
'배열에 넣기(dc에서 저장하고 있는 고유목록을 동적배열a에 넣기)
'---------------------------
ReDim a(nc.Count - 1)

For i = 0 To nc.Count - 1
    a(i) = nc(i + 1)
Next

'---------------------------
'동적배열a에 있는 값을 뿌리기
'---------------------------
Range("C1").Resize(1, UBound(a) + 1) = a
Range("B1").Resize(UBound(a) + 1, 1) = Application.Transpose(a)

위 결과값 그림상의 고유항목들이 오름 or 내림차순 정렬이 아니다.
이를 오름차순 정렬한 코드는 다음과 같다.
Dim nc As New Collection
Dim rng As Range, c As Range
Dim a() As Variant
Dim i As Long, j As Long
Dim temp As Variant

.................
'---------------------------
'배열에 넣기(dc에서 저장하고 있는 고유목록을 동적배열a에 넣기)
'---------------------------
ReDim a(nc.Count - 1)
For i = 0 To nc.Count - 1
    a(i) = nc(i + 1)
Next

'---------------------------
'정렬(버블정렬)
'---------------------------
For i = 0 To dc.Count - 2
    For j = i + 1 To dc.Count - 1
        If a(i) > a(j) Then
            temp = a(i)
            a(i) = a(j)
            a(j) = temp
        End If
    Next
Next
'---------------------------
'동적배열a에 있는 값을 뿌리기
'---------------------------
Range("C1").Resize(1, UBound(a) + 1) = a
Range("B1").Resize(UBound(a) + 1, 1) = Application.Transpose(a)

https://www.youtube.com/watch?v=uuyRUNZC2GE&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=49