본문 바로가기

100_Apps/VBA, Excel, Google spreadsheet

New Scripting.Dictionary 예제 (동영상 연결)

(참고 동영상) 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

반응형