시트생성 (2)
[VBA] Dictionary에 대한 이해4 - Dictionary & Collection2
반응형

[VBA] Dictionary에 대한 이해4 - Dictionary & Collection2

Dictionary의 Item으로서의 Collection 사용

 

Dictionary의 Item으로 올 수 있는 것들은 String,Number,Sheet,Workbook,Dictionary,Collection,True,False,.. 등이 있다.

Dictionary의 Item으로 Collection를 쓸 수 있다는 것이다.



Dictionary를 이용해 항목별로 시트 나누기

Sub groupByEmployee()

Dim sT: sT = 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

For r = 2 To rngX.Rows.Count
      Set rngY = rngX.Rows(r)
      sKey = rngY.Cells(1).Value
      
      If oDic.Exists(sKey) Then
            oDic.Item(sKey).Add rngX.Rows(r)    
            'oDic.Item(sKey) 은 Collection 임. 그림1참조
      Else
            Set oCol = New Collection
            oCol.Add rngX.Rows(1)         '제목 행 추가
            oCol.Add rngX.Rows(r)         'Collection에 rngX.Rows(r)의 데이타 넣어둔다
            oDic.Add sKey, oCol           'Dictionary에  Collection추가
      End If
Next r
   
Application.ScreenUpdating = False
      Dim sht As Worksheet
      '--------------------------------
      '시트명 '원본'이외의 시트삭제하기
      Application.DisplayAlerts = False
      For Each sht In Worksheets
            If Not (sht.Name = "원본") Then sht.Delete
      Next sht
      Application.DisplayAlerts = True
      '--------------------------------
      '종업원별로 시트 생성하기
      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 '그림2참조
            Next j
      Next vKey
          
      Worksheets("원본").Activate
Application.ScreenUpdating = True
MsgBox VBA.Timer - sT
End Sub

그림1
그림2




https://www.youtube.com/watch?v=fNw2-auVvXA&t=1661s

ㅁㅁㅁ

반응형
  Comments,     Trackbacks
엑셀 VBA #52 / 중복데이터 처리_5 [VBA]-고유항목별 합계구하기
반응형

엑셀 VBA #52 / 중복데이터 처리_5 [VBA]-고유항목별 합계구하기

Sub 중복데이터_시군구별합계()

Dim gu As New Collection
Dim rgu As Range, c As Range
Dim e As Variant
Dim tot As Long

Application.ScreenUpdating = False

Set rgu = Range("F2", Cells(Rows.Count, "F").End(xlUp))

'고유한 시군구 추출
On Error Resume Next
For Each c In rgu
    If Len(c) Then
        gu.Add Trim(c), CStr(Trim(c))
    End If
Next
On Error GoTo 0

'시군구별로 합계 ->시군구별 시트 생성->생성된 시트에 합계를 뿌리기
For Each e In gu        'e=new collection(gu)에 저장된 고유한 목록 하나하나..!
    tot = Application.SumIf(rgu, e, rgu.Offset(, 2))
    'sumif(조건범위, 조건,합을 구할 범위)
    '합을 구할 범위 'H2:H열 마지막행'인데 이를 'rgu.Offset(, 2)'로 하는게 Good!!!!
    Worksheets.Add(after:=Sheets(Sheets.Count)).Name = e  '시군구별 시트 생성
    With Sheets(e)
        .Range("A1").Resize(1, 2) = Array("시군구", "통화건수")
        .Range("A2") = e
        .Range("B2") = tot
    End With
Next
Application.ScreenUpdating = True

End Sub

vba#52.xlsm
0.81MB


https://www.youtube.com/watch?v=dHBovWeJbw8&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=52


반응형
  Comments,     Trackbacks
최근 작성 글
최근 작성 댓글
최근 작성 트랙백
프로필
공지사항
글 보관함
캘린더
«   2024/12   »
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31
TODAY TOTAL