🧨 엑셀 VBA / Dictionary 개체

🧨 엑셀 VBA / Dictionary 개체_실무

왼손오른손겸손 2022. 7. 31. 18:31

출처: https://lesserpainbetterlife.tistory.com/803 [전진수블로그 ✝ = ♥ 유배자의 영성:티스토리]
코딩 편집

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

* 코딩 원문

* 코딩 파일 자료: 엑셀디자인 (https://youtu.be/SrOrTwZuxXA)

VBA_119_완성.xlsm

0.02MB

* 에러 수정 : 중복 값이 있는 경우.... 해결 방법

(변경 전)

(변경 후)