[엑셀 실무][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 #93 / 특정 폴더 내, 파일통합_VBA필수 [VBA]

Sub Data_gether_from_otherfile()
      Dim strPath As String, fName As String
      Dim wb As Workbook
      Dim rngS As Range
      Dim cntRows As Long
      
      Application.ScreenUpdating = False
      
      strPath = "C:\Users\sss\ddd\바탕 화면\조사활동\가나다조사\팀별일일보고\"
      '위 코드의 문제점 해결위해 아래처럼 한다
      'strPath = Environ("userprofile") & "\바탕 화면\조사활동\가나다조사\팀별일일보고\"
      fName = Dir(strPath & "*.xls*")
      
      If fName = "" Then
            MsgBox "폴더내 엑셀 파일 없음"
            Exit Sub
      End If
      
      Do While fName <> ""
            Set wb = Workbooks.Open(Filename:=strPath & fName, UpdateLinks:=0)
            Set rngS = wb.Sheets(1).UsedRange
            Set rngS = rngS.Offset(1).Resize(rngS.Rows.Count - 1)
            cntRows = rngS.Rows.Count
            
            'rngS.Copy Sheet1.Cells(Rows.Count, "a").End(3)(2)
            '위 코드는 속도가 느리므로 아래처럼하자
            Sheet1.Cells(Rows.Count, "a").End(3)(2).Resize(cntRows, 17) = rngS.Value
            
            wb.Close
            fName = Dir
      Loop
      
      Application.ScreenUpdating = True
      
End Sub

본 코드의

장점 : 취합파일과 복사대상파일의 경로가 달라도 됨

단점 : 지정된 폴더의 모든 엑셀파일이 모여짐.

https://www.youtube.com/watch?v=IOFTEpvTw00&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=94

엑셀 VBA #90 / 데이터재배치 [VBA]

Sub vba90강231231()

Dim rng As Range, c As Range
Dim nc As New Collection
Dim j As Long, i As Long, k As Long
Dim a()

' C열 데이타를 텍스트 타입으로 바꾸기
Set rng = Range("c5", Cells(Rows.Count, "c").End(3))
rng.TextToColumns Destination:=rng, fieldinfo:=Array(1, 2)


'정렬하기
Range("b5", Cells(Rows.Count, "c").End(3)).Sort Range("b5", Cells(Rows.Count, "c").End(3))(1, 2)

'New Collection & 배열 접목
On Error Resume Next
For Each c In rng
      nc.Add Trim(c), CStr(Trim(c))
Next
On Error GoTo 0

j = 1   'j의 초기값을 설정하지않으면 0부터 시작함..nc의 초기값은 1이므로 본 코드 필요
i = 5
Range("e4").Select

Do
      Do While Cells(i, "c") = nc(j)
            ReDim Preserve a(k)
            a(k) = nc(j) 'nc(j)의 값을 동적배열 a변수에 집어 넣기
            ActiveCell.Offset(1) = k + 1
            ActiveCell.Offset(1, 1) = nc(j)
            ActiveCell.Offset(1).Select
            k = k + 1
            i = i + 1
      Loop
            j = j + 1
            k = 0
            Erase a
            ActiveCell.Offset(1).Select
Loop While j <= nc.Count


End Sub

https://www.youtube.com/watch?v=x9b1bRVoMic&t=736s

ㅁㅁㅁ

엑셀 VBA #85 / 이벤트 프로시저와 find 메서드 활용하기 [VBA]

Private Sub Worksheet_Change(ByVal Target As Range)

      Dim rng As Range
      Dim fc As Range
      
      If Not Intersect(Target, Columns("b")) Is Nothing Then
            Set rng = Sheet2.Range("a2:a32")
            
            On Error Resume Next
                  Set fc = rng.Find(Day(Target.Offset(0, -1)), , , xlWhole)
            On Error GoTo 0
            
            If Not fc Is Nothing Then
                  fc.Offset(0, 1) = Target.Value
            Else
                  MsgBox "정확한 값을 입력하세요."
            End If            
      End If
End Sub

2023.12.13 - 엑셀 VBA #13 / 셀 범위 선택하기_8 [VBA] - Intersect

2023.12.13 - 엑셀 VBA #14 / 셀 범위 선택하기_9 [VBA] - Intersect 실무예제

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

https://www.youtube.com/watch?v=qAAJvBXT7zo&t=414s