VBA Scripting.Dictionary 이해하기 - 최고

https://zasfe.tistory.com/entry/How-to-Scripting-Dictionary

Scripting.Dictionary 사용하기..1

https://www.youtube.com/watch?v=fNw2-auVvXA 

'도구 - 참조 - Microsoft Scripting Runtime

Sub dictionary항목별시트나누기()
' 더미데이터 만들기
' =CHOOSE(RANDBETWEEN(1,4),"AAA","BBB","CCC","DDD")
' =CHOOSE(RANDBETWEEN(1,4),"Bible","Mouse","PC","SmartPhone")
' =DATE(2019,RANDBETWEEN(1,12),RANDBETWEEN(1,31))
' =RANDBETWEEN(5,20)*1000
    Sheets("sample").Activate
    Dim startTime
    startTime = VBA.Timer

    Dim oDic As Scripting.Dictionary
    Set oDic = New Scripting.Dictionary
    
    Dim rngX As Range
    Set rngX = Range("A1").CurrentRegion
    Dim r As Long
    Dim rngY As Range
    Dim sKey As String
    Dim oCol As Collection
'Stop
    For r = 2 To rngX.Rows.Count
        Set rngY = rngX.Rows(r)
        'rngY.Select
        sKey = rngY.Cells(1).Value
        If oDic.Exists(sKey) Then
            oDic.Item(sKey).Add rngX.Rows(r) ' ? typename(oDic.Item(sKey))
        Else
            Set oCol = New Collection
            oCol.Add rngX.Rows(1) ' 제목
            oCol.Add rngX.Rows(r)
            
            oDic.Add sKey, oCol
        End If
    Next r
    ' ? oDic.Count
    ' ? oDic.Item("AAA").count
    
    Application.ScreenUpdating = False
    'Delete Sheets
    Dim sht As Worksheet
    Application.DisplayAlerts = False
    For Each sht In Worksheets
        If sht.Name <> "sample" Then sht.Delete
    Next sht
    Application.DisplayAlerts = True
    
'    Stop
    Dim vKey As Variant
    Dim j As Long
    
    For Each vKey In oDic.Keys
        Set sht = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        sht.Name = vKey
        Set oCol = oDic.Item(vKey)
        For j = 1 To oCol.Count
            sht.Range("A" & j).Resize(1, 4).Value = oCol.Item(j).Value ' typename(oCol.Item(j))
        Next j
    Next vKey
    
    Sheets("sample").Activate
    Application.ScreenUpdating = True
    MsgBox VBA.Timer - startTime
End Sub

Sub dictionary조건에맞는데이터다른시트()
' 더미데이터 만들기
' =CHOOSE(RANDBETWEEN(1,4),"AAA","BBB","CCC","DDD")
' =CHOOSE(RANDBETWEEN(1,4),"Bible","Mouse","PC","SmartPhone")
' =DATE(2019,RANDBETWEEN(1,12),RANDBETWEEN(1,31))
' =RANDBETWEEN(5,20)*1000
    Sheets("결과").UsedRange.Clear
    Sheets("sample").Activate
    Dim startTime
    startTime = VBA.Timer
    
    Dim searchData As String
    searchData = Range("F1")
    
    Dim oDic As Scripting.Dictionary
    Set oDic = New Scripting.Dictionary
    
    Dim rngX As Range
    Set rngX = Range("A1").CurrentRegion
    Dim r As Long ' 행
    Dim rngY As Range ' 현재 행
    Dim sKey As String
    Dim oCol As Collection
'Stop
    For r = 2 To rngX.Rows.Count '데이터영역만
        Set rngY = rngX.Rows(r) ' 현재 행
        'rngY.Select
        sKey = rngY.Cells(1).Value ' 현재 행의 첫 번째는 Key
        If sKey = searchData Then
            If oDic.Exists(sKey) Then ' Dictionary에 Key가 있으면
                oDic.Item(sKey).Add rngX.Rows(r) ' ? typename(oDic.Item(sKey))
            Else ' Dictionary에 Key가 없으면
                Set oCol = New Collection ' 고유값 New Collection
                oCol.Add rngX.Rows(1) ' Collection에 제목 행 추가
                oCol.Add rngX.Rows(r) ' Collection에 현재 행 추가
                
                oDic.Add sKey, oCol ' Dictionary에 새로운 Key와 나머지 데이터 Collection을 추가
            End If
        End If
    Next r
    If oDic.Count = 0 Then
        Sheets("sample").Range("G1").ClearContents
        MsgBox "찾을 값이 없습니다"
        Exit Sub
    End If
    ' ? oDic.Count
    ' ? oDic.Item("AAA").count
    
    Application.ScreenUpdating = False
    'Delete Sheets
'    Dim sht As Worksheet
'    Application.DisplayAlerts = False
'    For Each sht In Worksheets
'        If sht.Name <> "sample" Then sht.Delete
'    Next sht
'    Application.DisplayAlerts = True
    
'    Stop
    Dim vKey As Variant
    Dim j As Long
    
'    For Each vKey In oDic.Keys
'        Set sht = Worksheets.Add(after:=Worksheets(Worksheets.Count))
'        sht.Name = vKey
'        Set oCol = oDic.Item(sKey)
        For j = 1 To oCol.Count
            Sheets("결과").Range("A" & j).Resize(1, 4).Value = oCol.Item(j).Value ' typename(oCol.Item(j))
        Next j
'    Next vKey
    
    Sheets("sample").Activate
    Sheets("sample").Range("G1") = oCol.Count
    Application.ScreenUpdating = True
    MsgBox VBA.Timer - startTime
End Sub

dictionary항목별시트나누기.xlsm

0.04MB