(참고 동영상) https://youtu.be/1yBE6MGkIA4
Option Explicit
Sub PDictionary()
Dim rng As Range, c As Range, rngT As Range
Dim dict As New Scripting.Dictionary
Dim i As Long
Dim s
Application.ScreenUpdating = False
Range("d1").CurrentRegion.ClearContents
Range("a1").CurrentRegion.Copy Range("d1")
Range("d1").CurrentRegion.RemoveDuplicates Array(1, 2), xlYes
Set rng = Range("d2", Cells(Rows.Count, "d").End(3))
For Each c In rng
If dict.Exists(c.Value) Then
dict(c.Value) = dict(c.Value) & "," & c.Offset(, 1)
Else
dict.Add c.Value, c.Offset(, 1)
End If
Next
Set rngT = Range("g1")
For i = 0 To UBound(dict.Items)
s = Split(dict.Items(i), ",")
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 rngT = Nothing
End Sub
Option Explicit
Sub PDictionary()
' Dim dict As Object
' Set dict = CreateObject("scripting.dictionary")
Dim dict As New Scripting.Dictionary
Dim i As Long
Dim arr()
dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333
'Debug.Print dict("바나나")
dict.Items
dict.Keys
For i = 0 To UBound(dict.Items)
ReDim Preserve arr(i)
arr(i) = dict.Items(i)
Next
' Debug.Print UBound(arr)
' Debug.Print LBound(arr)
Range("a1:a3") = Application.Transpose(arr)
End Sub
'100_Apps > VBA, Excel, Google spreadsheet' 카테고리의 다른 글
🧨 엑셀 VBA / Dictionary 개체_실무 (0) | 2022.07.31 |
---|---|
🧨 엑셀 VBA / 배열, New Collection, Dictionary (0) | 2022.07.31 |
📌032-3 Excel VBA 📌 《도움말》에서 《Method》를 찾는 방법 ? (0) | 2022.07.19 |
📌032-2 Excel VBA 📌 워크시트 컬렉션(Wokrsheets Collection)의 《Add 메서드》 (0) | 2022.07.19 |
📌032-1 Excel VBA 📌Worksheets 컬렉션에서 사용할 수 있는 메서드(Method)의 종류 (0) | 2022.07.19 |