🧨 엑셀 VBA / Dictionary 개체_실무

출처: 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

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

(변경 전)

(변경 후)