매일 실시한 초과내역을 파일로 받아
월별로 초과내역을 누적시키는 매크로
A1을 누르면 매크로가 실행되고 B1을 누르면 시간이 재계산 되고 C1을 누르면 데이터가 초기화 된다.
1. 월초가 되어 기존 데이터가 없을 때는 초과내역을 통채로 가져오고
2. 기존 데이터가 있을 때는 초과를 한 날짜만 데이터를 가져오며
3. 인사이동 등으로 새로운 인물이 등장했을 때는 맨 밑에 데이터를 삽입한다.
4. "총합"에는 초과시간으로 인정받은 시간들이 합산된 시간이 입력된다.
5. 평일파일과 주말파일을 구분하여 가져온다.
6. 아침에 출근을 일찍하여 아직 퇴근을 찍지 않은 경우에는 데이터를 가져오지 않는다.
Sub getChogwa()
Dim newBook As Variant, oldBook As Workbook
Dim wsTime As Worksheet
Dim strSort As String
Dim i As Integer
Dim rng As Range
Dim rngfndName As Range
Dim rngCopy As Range
Dim dtDate As Date
Dim dtFile As Date
Dim strDate As String
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'B1을 선택하면 시간만 재계산
If ActiveCell = Range("B1") Then GoTo Relo
'시트가 2개 이상일 때 sheets1만 남기고 기존자료 삭제 후 sheet2 생성
If Sheets.Count > 1 Then
With Application
.DisplayAlerts = False
For i = 2 To Sheets.Count
Sheets(2).Delete
Next i
.DisplayAlerts = True
End With
End If
Sheets.Add after:=Sheets(Sheets.Count)
'변수 설정
strSort = "엑셀파일 (*.xls*), *.xls*"
Set oldBook = ActiveWorkbook
Set wsTime = oldBook.Sheets(1)
newBook = Application.GetOpenFilename(filefilter:=strSort, Title:="초과내역 선택")
'파일 선택 후 초과내역 복사하고 파일 닫기
If newBook <> False Then
'파일명에서 날짜 추출
Select Case InStr(newBook, "-")
Case Is > 0: strDate = Mid(newBook, InStrRev(newBook, "-") + 1, 8)
Case Is = 0: strDate = Mid(newBook, InStrRev(newBook, "\") + 1, 8)
End Select
dtFile = DateSerial(Left(strDate, 4), Mid(strDate, 5, 2), Right(strDate, 2))
Workbooks.Open Filename:=newBook
ActiveSheet.UsedRange.Copy oldBook.Sheets(2).Range("A1")
ActiveWorkbook.Close
oldBook.Activate
'파일 선택 안 하면 매크로 종료
Else
wsTime.Select
GoTo j
End If
'Sheet2에서 인정시간 없으면 전체 행 삭제(내가 헷갈려서 정리)
For i = Range("A1").CurrentRegion.Rows.Count To 2 Step -1
With Cells(i, "N")
If IsEmpty(.Value) Then .EntireRow.Delete
'근무일이 파일명에 있는 날짜보다 크면 전체행 삭제
If Cells(i, "G") > dtFile Then Rows(i).Delete
End With
Next i
'Sheet2에서 대상자 없는 총합은 전체행 삭제
For i = Range("A1").CurrentRegion.Rows.Count To 2 Step -1
If Cells(i, "B") = "총합" Then
If Cells(i - 1, "B") = "총합" Then Rows(i).Delete
End If
If i = 2 And Cells(i, "B") = "총합" Then Rows(i).Delete
Next i
wsTime.Activate
'Sheet1의 A2 셀이 비어있으면 월초로 판단하고 Sheet2의 모든 내용을 Sheet1에 복사
If IsEmpty(Range("A2")) Then
Sheets(2).Range("A1").CurrentRegion.Copy Range("A1")
'A2셀에 값이 있으면 기존 자료에 초과근무내역을 추가
Else
'sheet2의 이름을 순환하며 해당직원의 근무일이 없으면 sheet1에 근무일 추가
For Each rng In Sheets(2).Columns("F").SpecialCells(2)
If rng.Row <> 1 Then
Set rngfndName = Columns("F").SpecialCells(2).Find(what:=rng, SearchDirection:=xlPrevious, lookat:=xlWhole)
With rngfndName
'대상자가 있을 경우 맨 밑의 이름을 찾아서 초과근무내역 삽입
If Not rngfndName Is Nothing Then
'같은 근무일이 없을 때 초과근무내역 삽입
Select Case .End(xlUp)
Case Is = .Value
Set rngCopy = Range(Cells(.Row, "G"), Cells(.End(xlUp).Row, "G"))
Case Is <> .Value
Set rngCopy = Range(Cells(.Row, "G"), Cells(.End(xlUp).Offset(1).Row, "G"))
End Select
If rngCopy.Find(what:=rng.Offset(, 1), lookat:=xlWhole) Is Nothing Then
rng.EntireRow.Copy
.Offset(1).EntireRow.Insert shift:=xlShiftDown, copyorigin:=True
With .Offset(1).EntireRow.SpecialCells(2)
.Font.Name = "Arial"
.HorizontalAlignment = xlCenter
End With
End If
'인사이동 등으로 대상자가 없으면 초과근무내역 전체 삽입
Else
Select Case rng.End(xlDown)
Case Is = rng
Set rngCopy = rng.End(xlToLeft).Resize(rng.End(xlDown).End(xlDown).Offset(-1).Row - rng.Row + 1, 14)
Case Is <> rng
Set rngCopy = rng.End(xlToLeft).Resize(rng.Offset(1).Row - rng.Row + 1, 14)
End Select
rngCopy.Copy Cells(Rows.Count, "B").End(xlUp).Offset(1, -1)
End If
End With
End If
Next rng
End If
Relo:
For Each wsTime In Sheets
With wsTime
For Each rng In .Columns("B").SpecialCells(2)
If rng.Row <> 1 Then
'총합에 서식 지정
If rng.Value = "총합" Then
With rng.EntireRow.SpecialCells(2)
With .Font
.Bold = True
.Color = RGB(0, 102, 204)
End With
.HorizontalAlignment = xlCenter
End With
End If
'순번 입력
If rng <> "총합" Then
Select Case rng.Offset(-1, -1)
Case "번호", "": i = 1
Case Else: i = i + 1
End Select
rng.Offset(, -1) = i
End If
End If
Next rng
End With
Next wsTime
'N(인정)열을 시간으로 변경
For Each wsTime In Sheets
With wsTime
For Each rng In .Columns("N").SpecialCells(2)
If rng.Row <> 1 Then
If rng.Font.Color = RGB(0, 102, 204) Then
rng.NumberFormatLocal = "[hh]:mm"
rng = dtDate
dtDate = 0
Else
rng.NumberFormatLocal = "hh:mm"
rng.Value = rng.Value
dtDate = dtDate + rng
End If
End If
Next rng
End With
Next wsTime
'전체셀 열너비 자동설정
Range("A1").CurrentRegion.EntireColumn.AutoFit
j:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
cs
%EC%B4%88%EA%B3%BC%EA%B7%BC%EB%AC%B4%20%EB%82%B4%EC%97%AD.xlsm
0.04MB
20150424-20150426%20%EC%B4%88%EA%B3%BC%EA%B7%BC%EB%AC%B4%EB%82%B4%EC%97%AD.xlsx
0.01MB
'VB(A)' 카테고리의 다른 글
| 셀 안의 문자열 삭제 (0) | 2015.05.03 |
|---|---|
| 자동필터를 이용한 데이터 검색 (0) | 2015.05.02 |
| 흩어진 글자들을 한줄로 오름차순 정렬 (1) | 2015.04.22 |
| 표를 달력으로 보내기 (2) | 2015.04.20 |
| 자동 빼기 (1) | 2015.04.19 |