[엑셀 실무][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
ㅁ

고유목록 추출

A열의 목록에서 '고유목록'을 추출하여,
B열에 있는 값들 중 '고유목록'에 해당하는 값들의 합계를 구해서 넣는 것으로
SUMIF함수를 이용하여 값을 구할 수 있다.

고유목록은 New Collection객체를 이용하여 추출할 수 있어서 For Each ~ Next문으로 Add매서드를 이용하여 구할 수 있다.
(New Collection객체는 중복된 항목을 제거하고 고유의 항목만 가지게 하는 객체로서
고유한 목록을 추가해 주는 Add매서드를 반드시 이용하여 작업해야 함)

New Collection객체의 변수 sj에 Add매서드를 이용하여, 공백제거된 문자화된 고유의 목록만 저장
sj.Add Trim(r),CStr(Trim(r))

'-----코드 시작
Dim sj As New Collection
Dim r As Range
Dim k As Long

On Error Resume Next   '중복된 값이 있으면 에러를 발생시킴으로 에러가 나면 그냥 넘어가라
For Each r in Range("A2:A21")
sj.Add Trim(r),CStr(Trim(r))    '고유항목만 뽑아서 공백을 제거하고, 텍스트화
Next
On Error Goto
'-----코드 끝



sj에 저장된 고유의 목록을 k변수의 순서에 따라 For문에 넣어 반복하고, 목록과 값이 들어갈 셀에 넣어주면 됨
(합계를 구하는 함수는 sumif을 이용하여 구해서 넣어줌)


'----코드 시작
For k = 1 to sj.count
Cells(k+1,"d") = sj(k)
Cells(k+1,"e") = Application.Sumif(Range("A2:A21"),sj(k),Range("B2:B21")
Next
'-----코드 끝





Range("A2:A21")와 Range("B2:B21")을 변수처리하여 문장을 조금 더 간단하게 만들어 주어도 될 것 같네요

'----코드 시작-
Dim tk As Range, kr As Range
Set tk = Range("A2:A21")
Set kr = Range("B2:B21")

For k = 1 To sj.count
Cells(k+1,"d") = sj(k)
Cells(k+1,"e") = Applcation.Sumif(tk,sj(k),kr)
Next
'-----코드 끝



https://blog.naver.com/romyok12/222930690848

Sub test()

Dim rngA As Range '전체 범위변수
Dim rngB As Range   'For Each를 위한 단일 셀 변수
Dim C As New Collection   '원하는 데이터를 담아줄 Collection선언

Set rngA = Range("C3", Cells(Rows.Count, "c").End(xlUp))
'ranA에는 C3부터 C열 마지막 행까지의 범위를 담아줘
'반복문을 통한 Collection에 값 담아주기

On Error Resume Next


For Each rngB In rngA
'rngA에서 하나의 셀씩 반복해줘
    If Len(rngB) Then  'rngB에 데이타가 있다면
                C.Add Trim(rngB), CStr(Trim(rngB))
               'C라는 Collection에 rngB의 앞뒤 공백을 제거하고 추가해주고,
                         'Key값으로는 CStr을 이용하여 앞뒤공백을 제거해준 rngB값으로 해줘
        End If
Next



Dim i As Long 'Collection을 반복문으로 값을 뿌려주기 위한 변수
     For i = 1 To C.Count ' Collecdtion C의 갯수만큼 반복해줘
     Cells(2 + i, "f") = C(i) '2+i행,f열에 C의 i번째 아이템을  넣어줘
Next

End Sub   '출처 :https://blog.naver.com/mrdjrblog/222456575897