최대로 고민하고 머리를 짰던 매크로다.
16개를 복사하고 17개부터는 다른 행부터 삽입을 해야하는 난관.
결국 select 함수와 각종 변수로 떡칠을 하여 완성했다.
책아 어서 와라.
Sub 직종별양식()
Dim rngWork As Range
Dim rngDblWork As Range
Dim snWork As Range
Dim rngName As Range
Dim rngStart As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
'기존 워크시트 삭제
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
For i = 5 To Sheets.Count
Sheets(5).Select
Sheets(5).Delete
Next i
'작업을 위한 임시 시트 생성
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Temp"
Set rngWork = Sheets("입력").Range("B8") '직종
Set rngName = Sheets("입력").Range("C8") '이름
Set rngDblWork = Sheets("Temp").Range("A1") '임시시트의 임시셀
'직종별 시트를 만들기 위해 직종 오름차순으로 정렬 후 가져오기
With rngWork
Range(.Cells, Cells(.CurrentRegion.Rows.Count + 6, "BA")).Sort .Cells, 1
Range(.Cells, .End(xlDown)).Copy
rngDblWork.Select
Selection.PasteSpecial Paste:=xlPasteValues
End With
On Error GoTo 0
Application.CutCopyMode = False
'직종 가져온 후 중복값 제거
Selection.RemoveDuplicates 1
j = 1
For Each snWork In rngDblWork.CurrentRegion
'직종 이름으로 시트 생성
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = snWork
Set rngStart = Sheets(Sheets.Count).Range("E5") '1일
'양식 시트를 열너비 복사 후 1,2행 복사
Sheets("양식").Select
Rows("1:2").Copy
Sheets(Sheets.Count).Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths
ActiveSheet.Paste
'16을 기준으로 순번부터 소계까지 반복해서 복사
With rngWork
k = WorksheetFunction.CountIf(Range(.Cells, .End(xlDown)), Sheets(Sheets.Count).Name) '직종별 개수
For i = 0 To WorksheetFunction.RoundUp(k / 16, 0) - 1 '양식 복사할 횟수
Sheets("양식").Rows("3:38").Copy Sheets(Sheets.Count).Rows(3 + 36 * i)
Next i
End With
y = 0
For i = 0 To (k - 1) * 2 Step 2
Select Case y
Case Is <= 15 + 16 * 0: x = 4 * 0
Case Is <= 15 + 16 * 1: x = 4 * 1
Case Is <= 15 + 16 * 2: x = 4 * 2
Case Is <= 15 + 16 * 3: x = 4 * 3
Case Is <= 15 + 16 * 4: x = 4 * 4
Case Is <= 15 + 16 * 5: x = 4 * 5
End Select
'직종별 시트에 자료 입력
With rngStart
.Offset(i + x, -4) = rngName.Offset(j - 1, -2) '순번
.Offset(i + x, -3) = rngName.Offset(j - 1, -1) '직종
.Offset(i + x, -2) = rngName.Offset(j - 1, 0) '이름
.Offset(i + x, -1) = rngName.Offset(j - 1, 47) '주민번호
.Offset(i + x + 1, -3) = rngName.Offset(j - 1, 48) '주소
.Offset(i + x + 1, 15) = rngName.Offset(j - 1, 31) '31일
.Offset(i + x, 16) = rngName.Offset(j - 1, 32) '공수
.Offset(i + x + 1, 16) = rngName.Offset(j - 1, 33) '단가
.Offset(i + x, 17) = rngName.Offset(j - 1, 34) '금액
.Offset(i + x + 1, 17) = rngName.Offset(j - 1, 35) '기타
.Offset(i + x, 18) = rngName.Offset(j - 1, 36) '지급액계
.Offset(i + x, 19) = rngName.Offset(j - 1, 37) '갑근세
.Offset(i + x + 1, 19) = rngName.Offset(j - 1, 38) '주민세
.Offset(i + x, 20) = rngName.Offset(j - 1, 39) '고용보험
.Offset(i + x + 1, 20) = rngName.Offset(j - 1, 40) '가불
.Offset(i + x, 21) = rngName.Offset(j - 1, 41) '공제액계
.Offset(i + x, 22) = rngName.Offset(j - 1, 42) '차감지급
.Offset(i + x, 23) = rngName.Offset(j - 1, 43) '이월금
.Offset(i + x + 1, 23) = rngName.Offset(j - 1, 44) '총지급
.Offset(i + x, 24) = rngName.Offset(j - 1, 45) '실지급
.Offset(i + x + 1, 24) = rngName.Offset(j - 1, 46) '미지급
.Offset(i + x, 25) = rngName.Offset(j - 1, 49) '은행
.Offset(i + x + 1, 25) = rngName.Offset(j - 1, 50) '계좌
For z = 1 To 15
.Offset(i + x, z - 1) = rngName.Offset(j - 1, z) '15일
.Offset(i + x + 1, z - 1) = rngName.Offset(j - 1, 15 + z) '30일
Next z
End With
j = j + 1
y = y + 1
Next i
rngStart.Select
Next snWork
'마무리
Sheets("Temp").Delete
Sheets(5).Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
'VB(A)' 카테고리의 다른 글
시간대별 근무인원 구하기 (0) | 2015.02.10 |
---|---|
사용자정의 함수 (0) | 2015.02.07 |
Private Sub Worksheet_Change(ByVal Target As Range) (0) | 2015.01.30 |
Select Case 를 활용한 다중 조건 처리 (0) | 2015.01.28 |
자동채우기 (0) | 2015.01.18 |