[엑셀 실무][range.find를 이용한](여러 업체가 있는 )업체명부에서 업체별로 (열 단위로)근무자 뽑아내기

위 자료를 아래 모양을 바꾸기

Sub get_com_man()

Dim rngX As Range
Dim shtX As Worksheet
Dim shtY As Worksheet

Set shtX = Worksheets("업체명부")
Set shtY = Worksheets("근무자")
Set rngX = shtX.Range("a1").CurrentRegion

Dim r As Long
Dim row As Range
Dim scode As String
Dim rngF As Range     'Find는 값을 찾으나 Range 의 형식을 갖는다

shtY.Range("a2:y10000").Clear

For r = 2 To rngX.Rows.Count
   Set row = rngX.Rows.Item(r)   'rngX의 행범위를 담는다.
   scode = row.Cells(1).Value   '왼 코드를 이 코드(scode = row.Cells(r, "a").Value)로 바꾸면
   '값이 이상해지고,디버그발생한다. 왜?
   Set rngF = shtY.Columns(1).Find(scode)  'Columns(1) = Columns("A:A")
   'shtY.Range("a2:y10000").Clear '본 코드를 이 자리에 있으면 모듈 에러남...?
      If rngF Is Nothing Then
         shtY.Range("a10000").End(xlUp).Offset(1).Resize(1, 3).Value = _
         Array(row.Cells(1).Value, row.Cells(2), row.Cells(4).Value)
      Else
         rngF.End(xlToRight).Offset(0, 1).Value = row.Cells(4).Value
      End If
Next r
End Sub

For r = 2 To rngX.Rows.Count
   Set row = rngX.Rows.Item(r)
   scode = row.Cells(1).Value
   Set rngF = shtY.Columns(1).Find(scode)

      If rngF Is Nothing Then
         shtY.Range("a10000").End(xlUp).Offset(1).Resize(1, 3).Value = _
         Array(row.Cells(1).Value, row.Cells(2), row.Cells(4).Value)
      Else
         rngF.End(xlToRight).Offset(0, 1).Value = row.Cells(4).Value
      End If


https://www.youtube.com/watch?v=pqFFI-SNs_g&list=PLxmyPu_Id2snuVKanUgX_buujbFPjiY-R&index=108

2023.12.15 - 엑셀 VBA #42 / Find메서드_기본 [VBA]

2024.01.11 - [VBA] Dictionary에 대한 이해1

[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

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

ㅁㅁㅁ

Dictionary의 Item으로서의 Collection 사용

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

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

Sub Dic_Col240117()

Dim oDic As New Scripting.Dictionary
Dim rngX As Range
Dim vData As Variant
Dim sKey As String
Dim r As Long
Dim Col As New Collection
Dim vMoney As String, vSubject As String

Set rngX = Range("a2").CurrentRegion
vData = rngX.Offset(1).Resize(rngX.Rows.Count - 1).Value

For r = 1 To UBound(vData, 1)
      sKey = Join(Array(vData(r, 2), vData(r, 3), vData(r, 4), vData(r, 5)), "-")
      If oDic.Exists(sKey) Then
           Set Col = oDic.Item(sKey)
           'oDic딕셔너리에 담겨진 sKey의 item값이 Col로 리턴된다.
           'oDic.Item(sKey)는 oDic의 value를 의미한다
           '본 모듈에서 Collection이 Dictionary의 Item으로 구성되는 것으로 예시하고 있다.
            
            vMoney = Col.Item("money") & "+" & vData(r, 6)
            '상기 코드를 아래와 같이 하면 안된다..이유는
            'Col.Item("money")=Col.Item("money")& "+" & vData(r, 6)
            'Collection은 정해진 것을 불러오기는 되지만, 
            '정해진 것을 수정할 수 없기 때문이다????.
            
            Col.Remove "money"
            Col.Add vMoney, "money"
            
            vSubject = Col.Item("subject") & "/" & vData(r, 8)
            Col.Remove "subject"
            Col.Add vSubject, "subject"
      Else
            Set Col = New Collection
            Col.Add vData(r, 6), Key:="money"
            Col.Add vData(r, 8), Key:="subject"
            oDic.Add sKey, Col
      End If
Next r

Dim Key As Variant
Dim rTarget As Range
Dim iR As Long

iR = 1
Set rTarget = Range("a20")

For Each Key In oDic.Keys
      vMoney = oDic.Item(Key).Item("money")
      'oDic.Item(Key) : Col을 리턴한다.
      '=>Col.Item("money")로 리턴한다.
      vSubject = oDic.Item(Key).Item("subject")
      'oDic.Item(Key) : Col을 리턴한다.
      '=>Col.Item("subject")로 리턴한다.
      
      rTarget.Offset(0, 1).Resize(1, 4).Value = Split(Key, "-")
      rTarget.Offset(0, 5).Value = Application.Evaluate(vMoney)
      rTarget.Offset(0, 7).Value = vSubject
        
      rTarget.Value = iR
      iR = iR + UBound(Split(vSubject, "/")) + 1
      Set rTarget = rTarget.Offset(1, 0)
Next


End Sub

https://www.youtube.com/watch?v=LYoYT3A9l64&t=1056s
ㅁ

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

즉 눈에 띄는 것이 Dictionary이다.

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

Sub Double_Dictionary240116()

      Dim oDic As New Scripting.Dictionary
      Dim rngO As Range
      Dim vData As Variant
      Dim sKey As String, r As Long
      
      Set rngO = Range("a2").CurrentRegion
      vData = rngO.Offset(1).Resize(rngO.Rows.Count - 1).Value
      '"rngO.Offset(1).Resize(rngO.Rows.Count - 1)"구간의 값을 vData라는 배열방에 집어넣는다.
      
      Dim oDicX As Scripting.Dictionary
      
      For r = 1 To UBound(vData, 1)
            sKey = Join(Array(vData(r, 2), vData(r, 3), vData(r, 4), vData(r, 5)), "-")
            If oDic.Exists(sKey) Then
                  Set oDicX = oDic.Item(sKey)    
                  'odic(딕셔너리)의 item값은 odicx(딕셔너리)이다.
                  '--->odic의 item값은 odicx이다
                  oDicX.Item("money") = oDicX.Item("money") & "+" & vData(r, 6)   
                  'oDicX.Item("money")의미:odicx의 key값이 money인 item의 값! 
                  '즉 딕셔너리odicx에서 money의 item값!!
                  oDicX.Item("subject") = oDicX.Item("subject") & "/" & vData(r, 8)
            Else
                  Set oDicX = New Scripting.Dictionary 'odicx라는 새로운 딕셔너리 생성하여
                  oDicX.Add "money", vData(r, 6)   
                  'key값이 money이며 vdata(r,6)을 item값으로 하여 odicx(딕셔너리)에 더한다.
                  oDicX.Add "subject", vData(r, 8)   
                  'key값이 subject이며 vdata(r,8)을 item값으로 하여 odicx(딕셔너리)에 더한다.
                  oDic.Add sKey, oDicX    
                  'key값이 skey이며 odicx를 item값으로 하여 odic(딕셔너리)에 더한다.
            End If
      Next r
           
      Dim key As Variant
      Dim rTarget As Range
      Dim iR As Long
      Dim vMoney As String, vSubject As String
      
      Set rTarget = Range("a20")
      iR = 1
      
      For Each key In oDic.Keys
            vMoney = oDic.Item(key).Item("money")  
            'odic.item(key)는 odicx딕셔너리임!!!.
            '따라서 odicx.item("money")는 vdata(r,6)임??
            vSubject = oDic.Item(key).Item("subject")
            
            rTarget.Offset(0, 1).Resize(1, 4).Value = Split(key, "-")
            rTarget.Offset(0, 5).Value = Application.Evaluate(vMoney)
            rTarget.Offset(0, 7).Value = vSubject
          
            rTarget.Value = iR   '??????
            iR = iR + UBound(Split(vSubject, "/")) + 1   '???????
            
            Set rTarget = rTarget.Offset(1, 0)
      Next
End Sub

https://www.youtube.com/watch?v=IMhzMtDCUO8&t=1075s

Dictionary에 대한 이해

- Key,Item
- Item으로는 String,Number,Sheet,Workbook,Dictionary,Collection,True,False,..가 될 수 있다. 개념도2

Dictionary구성원
- Add : 사전에 새로운 키와 항목을 추가 Add(key,Item)
- CopareMode
- Count : 사전의 항목수를 가져옴
- Exists : 지정한 키가 사전에 있는 확인함
- Item : 지정한 키에 대해 항목을 설정하거나 가져옴 Item(Key)
- Items : 사전의 모든 항목을 포함하는 배열을 가져옴  Function Items()
-Key : 다른 키로 바꿈 Key(Key)
-Keys :  사전의 모든 키를 포함하는 배열을 가져옴 Function Keys()

엑셀 VBA #127 / Vlookup시리즈3_배열+Dictionary활용 [VBA]

Sub Vlookup기능실현_New_Scripting_Dictionary_배열231228()
      
      Dim dict As New Scripting.Dictionary
      Dim rngS, rngF
      Dim i As Long
      Dim arr()
      
      rngS = Sheet1.Range("a2", Sheet1.Cells(Rows.Count, "b").End(3)) 'rngS배열방 지정
      rngF = Sheet2.Range("a2", Sheet2.Cells(Rows.Count, "a").End(3)) 'rngT배열방 지정
      
      For i = 1 To UBound(rngS, 1)
            If dict.Exists(rngS(i, 1)) Then
            Else
                  dict.Add rngS(i, 1), rngS(i, 2)
                  'rngS(i,1)은 Key값, rngS(i,2)는 Item값임!!!!!
                  'cells(i,1)..cells(i,2)가 아님에 주의
            End If
      Next

      ReDim arr(1 To UBound(rngF, 1), 1 To 1)
      For i = 1 To UBound(rngF, 1)
            If dict.Exists(rngF(i, 1)) Then
                  arr(i, 1) = dict(rngF(i, 1))
                  ' "rngF(i,1)"은 Key값이고, 
                  "dict(rngF(i,1))"은 그 Key값에 해당하는 Item의 값임!!!!!!!
            Else
            End If
      Next
      
      Sheet2.Range("e2").Resize(UBound(arr, 1), 1) = arr

End Sub

엑셀 VBA #118 / Dictionary 개체_기본 [VBA]
엑셀 VBA #119 / Dictionary 개체_실무 [VBA]



https://www.youtube.com/watch?v=I4iyh9tF5kc&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=129
ㅁㅁ

Dictionary방식( Late Binding & Early Binding)

1. Late Binding : 'MicroSoft Scripting Runtime'체크확인 불필요

Sub usedictionary()

Dim rDatas As Range
Dim oDic As Object                          '일단 범용 Object로 선언 후
Dim rRow As Range
Dim sKey As String
Dim iItem As Integer
Dim ix As Integer

Set rDatas = Worksheets("Sales").Range("A1").CurrentRegion
Set rDatas = rDatas.Offset(1).Resize(rDatas.Rows.Count - 1)

Set oDic = CreateObject("scripting.Dictionary")    'Dictionary로 지정한다.

For Each rRow In rDatas.Rows
    sKey = rRow.Cells(3) 
    iItem = rRow.Cells(4)
    If Not oDic.exists(sKey) Then
        oDic.Add sKey, iItem
    Else
        oDic(sKey) = oDic(sKey) + iItem
    End If
Next

With Range("H1")
    For ix = 0 To oDic.Count - 1
        .Offset(ix) = oDic.keys()(ix)                ()() 반드시 지켜야 한다.
        .Offset(ix, 1) = oDic.items()(ix)           ()() 반드시 지켜야 한다.
    Next
End With
End Sub

https://www.youtube.com/watch?v=wKbOZpZ9vVQ

2. Early Binding : 'MicroSoft Scripting Runtime'체크확인 필요

Sub usedictionary2()

Dim rDatas As Range
Dim oDic As Scripting.Dictionary

Dim rRow As Range
Dim sKey As String
Dim iItem As Integer

Dim ix As Integer

Set rDatas = Worksheets("Sales").Range("A1").CurrentRegion
Set rDatas = rDatas.Offset(1).Resize(rDatas.Rows.Count - 1)

Set oDic = New Dictionary

For Each rRow In rDatas.Rows
    sKey = rRow.Cells(3)
    iItem = rRow.Cells(4)
      If Not oDic.exists(sKey) Then
        oDic.Add sKey, iItem
    Else
        oDic(sKey) = oDic(sKey) + iItem
    End If
Next

With Range("H1")
    For ix = 0 To oDic.Count - 1
        .Offset(ix) = oDic.keys(ix)             ()() or () 둘 중 하나 사용해도 된다.
        .Offset(ix, 1) = oDic.Items(ix)       ()() or () 둘 중 하나 사용해도 된다.
    Next
End With
End Sub

https://www.youtube.com/watch?v=aFKrdTGgUT8

https://raymond.tistory.com/2246

엑셀 VBA #118 / Dictionary 개체_기본 [VBA]

엑셀 VBA #118 / Dictionary 개체_기본 [VBA]

[New Dictionary]
Dim dict As Oject
Set dict = CreateObject("scripting.dictionary")
위 두 문장으로 된 구문( Late Binding이라 함)을

아래 하나의 문장으로 된 구문( Early Binding이라 함)으로 할 수 있다.

Dim dict As New Scripting.Dictionary



1.구조 
Dictionary이름명. Add  Key  Item


2. 예시
dict.Add "사과",111
dict.Add "바나나",222
dict.Add "딸기",333

3. For ~ Next문에 적용

3.1. 기본
Dim dict As New Scripting.Dictionary
Dim i As Long

dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333

For i = 0 To 2
    Cells(i + 1, 1) = dict.Items(i)
Next

위 구문의 문제점은 Item 갯수가 아주 많은 경우에는 처리속도가 느려진다는 것이다..

그래서 Key  및 Item값을 워크시트에 한꺼번 뿌려줄 필요가 있다.

이것을 할 수 있는 방법이 '배열'이다.

3.1. 동적배열

Dim dict As New Scripting.Dictionary
Dim i As Long
Dim arr() As Variant    '동적배열 적용. arr()의 값 유형을 모르니 Variant로 한다.

dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333

For i = 0 To 2
    'Cells(i + 1, 1) = dict.Items(i)
    ReDim Preserve arr(i)   ' 동적배열 적용문으로 동적배열의 사이즈를 i값으로 재선언
    arr(i) = dict.Items(i)        'item(i)값을 arr방에 집어넣기!!!!
Next

이제는 arr방에 들어온 item(i)값을 시트에 뿌려보자

......

   arr(i) = dict.Items(i)
Next

range("A1:A3") =arr

메모리 상에서는 arr은 아래 그림처럼 가로로 담겨져 있다.

이를 A1:A3로 올바르게 뿌려지기 위해서는 Transpose함수를 아래처럼 적용해야 한다.

range("A1:A3") =Application.transpose(arr)

3.1.1. UBound & LBound

For~Next문에서 i의 마지막 값을 프로그램이 자동으로 지정할 수 있도록 해야한다. 하드코딩하는 방법을 바람직하지 않다.프로그램이 알아서 값을 지정할 수 있도록 하는 변수에는 UBound와 LBound가 있다.

For i = 0 To 2

For i = 0 To UBound(dict.Items)   

4. 최종 코드

Sub Pdictionary()

Dim dict As New Scripting.Dictionary
Dim i As Long
Dim arr() As Variant

dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333

For i = 0 To UBound(dict.Items)
    'Cells(i + 1, 1) = dict.Items(i)
    ReDim Preserve arr(i)
    arr(i) = dict.Items(i)
Next

Range("A1:A3") = Application.Transpose(arr)
 
End Sub

VBA - Dictionary(Late vs Early Binding) by 우노사설

https://www.youtube.com/watch?v=1yBE6MGkIA4&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=120