Re:이 과정을 VBA로 간단하게 어떻게 할까요.

[Lago]

에러가 있어 수정하여 다시 올립니다.  -------

* 1,6만 결과물로 보여지고 2~5는 코드로 해결했습니다.

* 통합시트를 기준으로 왼쪽에 위치하면 취합대상으로 간주됩니다.

* [기본양식] 이라는 시트를 추가하였으며(반드시필요) 숨기기 되어있는 상태입니다.

* 1의 결과는 [통합]시트에 6의 결

과는 새로운 시트에 생성됩니다. (노랑색으로 표시)

파일을 참조 하세요

코드는 아래와 같습니다.

Sub Lago_Summary()
     Dim Ary, xVar(), allVar()
     Dim i As Long, n As Long, c As Long
     Dim k As Long, j As Long, m As Long
     Dim a As Long, h As Long, s As Long
     Dim ss As String
     Dim str As String
     Dim ws As Worksheet
     Dim wsSum As Worksheet
     Dim wsT As Worksheet
     Dim wsForm As Worksheet
     Dim myY As Integer, myM As Integer
     Dim bln As Boolean
     Dim X As New Collection
     Dim Y As New Collection
     Dim myDays As Integer
     Dim strWS As String
    
     On Error GoTo Err1
     Set wsT = Sheets("통합")
     myY = InputBox("취합 할 년도(Year)를 입력하세요", "YEAR", Year(Date - 5))
     myM = InputBox("취합 할 월(Month)를 입력하세요", "Month", Month(Date - 5))
     c = 6
     s = 6
     strWS = myY & Format(myM, "00") & "집계"
     myDays = 25
     On Error Resume Next
     For Each ws In Sheets
          If ws.Index < wsT.Index Then
               With ws
                    Ary = .Range("A5:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Resize(, s)
                    For i = 1 To UBound(Ary, 1)
                         bln = False
                         Select Case Ary(i, 6)
                              Case "출근", "퇴근", "귀사", "외출"
                                   bln = True
                              Case Else
                                   bln = False
                         End Select
                         If bln Then
                              If Format(Ary(i, 1), "yyyymm") = myY & Format(myM, "00") Then
                              Else
                                   bln = False
                              End If
                         End If
                         If Ary(i, 1) = "" Then: bln = False
                         If Ary(i, 3) = "" Then: bln = False
                         If Ary(i, 4) = "" Then: bln = False
                         If Ary(i, 5) = "" Then: bln = False
                         a = a + 1
                         ReDim Preserve allVar(1 To s, 1 To a)
                         For h = 1 To s
                              allVar(h, a) = Ary(i, h)
                         Next
                         If bln Then
                              ss = Ary(i, 3) & "_" & Ary(i, 4) & "_" & Ary(i, 5)
                              str = Ary(i, 1) & "_" & ss
                              m = 0
                              m = Y.Item(CStr(str))
                              If m > 0 Then
                              Else
                                   j = j + 1
                                   Y.Add j, CStr(str)
                                   k = 0
                                   k = X.Item(CStr(ss))
                                   If k > 0 Then
                                         xVar(2, k) = xVar(2, k) + 1
                                         xVar(3, k) = xVar(3, k) - 1
                                   Else
                                        n = n + 1
                                        X.Add n, CStr(ss)
                                        ReDim Preserve xVar(1 To c, 1 To n)
                                        xVar(1, n) = Ary(i, 4)
                                        xVar(2, n) = 1
                                        xVar(3, n) = myDays - 1
                                        xVar(4, n) = Ary(i, 5)
                                        xVar(6, n) = Ary(i, 3)
                                   End If
                              End If
                         End If
                    Next
               End With
          End If
     Next
     Erase Ary
     If n > 0 Then
          With wsT
               .Range("A4:A" & .Cells(Rows.Count, 1).End(xlUp).Row + 300).Resize(, s).EntireRow.Delete
               .Range("A4").Resize(a, s).Value = Application.Transpose(allVar)
               Erase allVar
          End With
          If Len(Sheets(strWS).Name) = 0 Then
               Set wsSum = Sheets.Add(, Sheets(Sheets.Count))
               wsSum.Name = strWS
          Else
               Set wsSum = Sheets(strWS)
          End If
          Set wsForm = Sheets("기본양식")
          With wsSum
               wsForm.Cells.Copy .Cells
               With .Range("B5").Resize(n, c - 1)
                    .Value = Application.Transpose(xVar)
                    .Cells.Borders.Weight = xlThin
                    Erase xVar
               End With
               .Range("B2") = myM
              
               .Activate
               .Tab.ColorIndex = 27
          End With
     End If
     Set X = Nothing: Set Y = Nothing
     Set ws = Nothing
     Set wsT = Nothing
     Set wsSum = Nothing
     Set wsForm = Nothing
     Exit Sub
Err1:
     MsgBox Err.Description & vbCr & vbCr & _
                    "실행이 중지되었습니다.", vbCritical, "실행 정지"
End Sub

근태현황_수집.xlsm

[카카루루]

감사합니다! 이걸 이제 앞으로 월마다 오는 DB(업체수8개에) 적용하고 싶습니다.
어떻게 해야될까요? 또 그 지문인식DB는 초기에 텍스트로 되었있지않습니다. 이부분은 또 어떻게 해야되죠?

[Lago]

개의 시트를 통합쉬트 왼쪽에 위치하면 취합 대상이므로 문제 없습니다.
단 양식은 지금과 동일 해야 합니다.

그리고 지문인식 DB가 무슨 의미 인지 잘 모르겠네요..!!
예제를 다시 만들어 올리세요..!! 가급적 가공하지 마시고..!!

[카카루루]

DB는 데이타베이스 약자입니다.

[이군악]

[Lago]님의 Code에 다시 한 번 감탄을 합니다.
엑셀의 개체가 충분하여 collection을 사용할 일은 거의 없다고 하는데, Collection 신공을 발휘하셨네요.
덕분에 개안을 하였습니다.
너무 고차원적인 무공이라 이해를 못하는 분들은 그냥 통합시트만 만든 후 Pivot Table 사용하는 방안을 조심스럽게 추천합니다. 출근/퇴근 값 중에서 큰 값을 취하여 작업을 하는 것 같은데요.

[Lago]

피벗 GoooooooD 입니다.
^^//

[카카루루]

추가질문입니다. 동명이인 걸러지는건가요?.

[Lago]

네..!! 기준은 [사번/이름/단말기ID] 를 기준으로 중복을 제거합니다.
동명이인이라면 위 3가지중 하나이상은 틀리겠죠!!

[카카루루]

라고님 제가 VBA해보지를 않아서요..
이걸 적용하는 메뉴얼좀 알려주세요 부탁드립니다.

[카카루루]

통합시트를 만들어야 되는건가요?