VB(A)

일정 간격으로 내용 복사

당근쨈 2015. 2. 3. 20:11

최대로 고민하고 머리를 짰던 매크로다.

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



표.xlsm



'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