[엑셀 vba] 순차적으로 나열된 당직 데이터를 실제 달력 폼으로 만들어주기

TEST.xlsm

		당직1	당직2	당직3	당직4	당직5	당직6	당직7	당직8	당직9
1	일	일		300	307			500	507	600	607
2	월	월		11	25
3	화	화		12	11
4	수	수		13	12
5	목	목		14	13
6	금	금		100	103
7	토	토		200	204	400	404
8	일	일		301	308			501	508	601	608
9	월	월		15	14
10	화	화		16	15
11	수	수		17	16
12	목	목		18	17
13	금	금		101	104
14	토	토		201	205	401	405
15	일	일		302	309			502	509	602	609
16	월	월		19	18
17	화	화		20	19
18	수	일		303	310			503	510	603	610
19	목	일		304	311			504	511	604	611
20	금	휴일		305	312			505	512	605	612	700
21	토	토		202	206	402	406
22	일	일		306	313			506	513	606	613
23	월	월		21	20
24	화	화		22	21
25	수	수		23	22
26	목	목		24	23
27	금	금		102	105
28	토	토		203	207	403	407

 위와 같은 데이터를 만들었다고 했을때.......     다음과 같이...    달력폼으로 만드는  코드입니다.

Sunday		Monday		Tuesday		Wednesday		Thursday		Friday		Saturday
1		2		3		4		5		6		7
600	607
300	500	11		12		13		14		100		200	400
307	507	25		11		12		13		103		204	404
8		9		10		11		12		13		14
601	608
301	501	15		16		17		18		101		201	401
308	508	14		15		16		17		104		205	405
15		16		17		18		19		20	700	21
602	609					603	610	604	611	605	612
302	502	19		20		303	503	304	504	305	505	202	402
309	509	18		19		310	510	311	511	312	512	206	406
22		23		24		25		26		27		28
606	613
306	506	21		22		23		24		102		203	403
313	513	20		21		22		23		105		207	407

첫번째.. 달력에 필요한 만큼의 빈칸을 만들기..

msdn에 있는 엑셀로 달력만들기를 기초로 만들었습니당.. 추가한 소스는...   가로 세로 3칸 두칸씩 추가하는 코드를 넣었네영..

Sub CalendarMaker()
 
       ' Unprotect sheet if had previous calendar to prevent error.
       ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
          Scenarios:=False
       ' Prevent screen flashing while drawing calendar.
       Application.ScreenUpdating = False
       ' Set up error trapping.
      ' on Error GoTo MyErrorTrap
       ' Clear area a1:g14 including any previous calendar.
       Range("a2:aa50").Clear
       ' Use InputBox to get desired month and year and set variable
       ' MyInput.
       'MyInput = InputBox("Type in Month and year for Calendar ")
       
        MyInput = Format(Range("a1").Value, "mm yyyy")
       
      
       
       
       StartDay = DateValue(MyInput)
       ' Allow user to end macro with Cancel in InputBox.
       If MyInput = "" Then Exit Sub
       ' Get the date value of the beginning of inputted month.
       StartDay = DateValue(MyInput)
       ' Check if valid date but not the first of the month
       ' -- if so, reset StartDay to first day of month.
       If Day(StartDay) <> 1 Then
           StartDay = DateValue(Month(StartDay) & "/1/" & _
               Year(StartDay))
       End If
       ' Prepare cell for Month and Year as fully spelled out.
      ' Range("a1").NumberFormat = "mmmm yyyy"
       ' Center the Month and Year label across a1:g1 with appropriate
       ' size, height and bolding.
     '  With Range("a1:g1")
      '     .HorizontalAlignment = xlCenterAcrossSelection
       '    .VerticalAlignment = xlCenter
        '   .Font.Size = 18
         '  .Font.Bold = True
         '  .RowHeight = 35
       'End With
       ' Prepare a2:g2 for day of week labels with centering, size,
       ' height and bolding.
       With Range("a2:g2")
           .ColumnWidth = 11
           .VerticalAlignment = xlCenter
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlCenter
           .Orientation = xlHorizontal
           .Font.Size = 12
           .Font.Bold = True
           .RowHeight = 20
       End With
       ' Put days of week in a2:g2.
       Range("a2") = "Sunday"
       Range("b2") = "Monday"
       Range("c2") = "Tuesday"
       Range("d2") = "Wednesday"
       Range("e2") = "Thursday"
       Range("f2") = "Friday"
       Range("g2") = "Saturday"
       ' Prepare a3:g7 for dates with left/top alignment, size, height
       ' and bolding.
       With Range("a3:g8")
           .HorizontalAlignment = xlLeft
           .VerticalAlignment = xlTop
           .Font.Size = 18
           .Font.Bold = True
           .RowHeight = 21
       End With
       ' Put inputted month and year fully spelling out into "a1".
      ' Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
       ' Set variable and get which day of the week the month starts.
       dayofweek = Weekday(StartDay)
       ' Set variables to identify the year and month as separate
       ' variables.
       CurYear = Year(StartDay)
       CurMonth = Month(StartDay)
       ' Set variable and calculate the first day of the next month.
       FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
       ' Place a "1" in cell position of the first day of the chosen
       ' month based on DayofWeek.
       Select Case dayofweek
           Case 1
               Range("a3").Value = 1
           Case 2
               Range("b3").Value = 1
           Case 3
               Range("c3").Value = 1
           Case 4
               Range("d3").Value = 1
           Case 5
               Range("e3").Value = 1
           Case 6
               Range("f3").Value = 1
           Case 7
               Range("g3").Value = 1
       End Select
       ' Loop through range a3:g8 incrementing each cell after the "1"
       ' cell.
       For Each Cell In Range("a3:g8")
           RowCell = Cell.Row
           ColCell = Cell.Column
           ' Do if "1" is in first column.
           If Cell.Column = 1 And Cell.Row = 3 Then
           ' Do if current cell is not in 1st column.
           ElseIf Cell.Column <> 1 Then
               If Cell.Offset(0, -1).Value >= 1 Then
                   Cell.Value = Cell.Offset(0, -1).Value + 1
                   ' Stop when the last day of the month has been
                   ' entered.
                   If Cell.Value > (FinalDay - StartDay) Then
                       Cell.Value = ""
                       ' Exit loop when calendar has correct number of
                       ' days shown.
                       Exit For
                   End If
               End If
           ' Do only if current cell is not in Row 3 and is in Column 1.
           ElseIf Cell.Row > 3 And Cell.Column = 1 Then
               Cell.Value = Cell.Offset(-1, 6).Value + 1
               ' Stop when the last day of the month has been entered.
               If Cell.Value > (FinalDay - StartDay) Then
                   Cell.Value = ""
                   ' Exit loop when calendar has correct number of days
                   ' shown.
                   Exit For
               End If
           End If
       Next
 
       ' Create Entry cells, format them centered, wrap text, and border
       ' around days.
       For x = 0 To 5
           For q = 1 To 3
           Range("A4").Offset(x * 4 + q - 1, 0).EntireRow.Insert
           
           With Range("A4:G4").Offset(x * 4 + q - 1, 0)
               .RowHeight = 20
               .HorizontalAlignment = xlCenter
               .VerticalAlignment = xlTop
               .WrapText = True
               .Font.Size = 10
               .Font.Bold = False
               ' Unlock these cells to be able to enter text later after
               ' sheet is protected.
               .Locked = False
           End With
           Next
           
           
           'Next
           
           ' Put border around the block of dates.
           'With Range("A3").Offset(x * 2, 0).Resize(2, _
           7).Borders(xlLeft)
           '    .Weight = xlThick
            '   .ColorIndex = xlAutomatic
           'End With
 
          'With Range("A3").Offset(x * 2, 0).Resize(2, _
          ' 7).Borders(xlRight)
           '    .Weight = xlThick
            '   .ColorIndex = xlAutomatic
           'End With
          ' Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
           '   Weight:=xlThick, ColorIndex:=xlAutomatic
       Next
       
        For x = 0 To 6
           
           Range("b2").Offset(0, x * 2).EntireColumn.Insert
           
           With Range("b2:b24").Offset(0, x * 2)
               .RowHeight = 20
               .HorizontalAlignment = xlCenter
               .VerticalAlignment = xlTop
               .WrapText = True
               .Font.Size = 10
               .Font.Bold = False
               ' Unlock these cells to be able to enter text later after
               ' sheet is protected.
               .Locked = False
           End With
           
        Next
        
       
      ' If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
       '   .Resize(2, 8).EntireRow.Delete
       ' Turn off gridlines.
       'ActiveWindow.DisplayGridlines = False
       ' Protect sheet to prevent overwriting the dates.
       'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
          Scenarios:=True
 
       ' Resize window to show all of calendar (may have to be adjusted
       ' for video configuration).
       ActiveWindow.WindowState = xlMaximized
       ActiveWindow.ScrollRow = 1
 
       ' Allow screen to redraw with calendar showing.
       Application.ScreenUpdating = True
       ' Prevent going to error trap unless error found by exiting Sub
       ' here.
       Exit Sub
   ' Error causes msgbox to indicate the problem, provides new input box,
   ' and resumes at the line that caused the error.
'MyErrorTrap:
  '     MsgBox "You may not have entered your Month and Year correctly." _
   '        & Chr(13) & "Spell the Month correctly" _
    '       & " (or use 3 letter abbreviation)" _
     '      & Chr(13) & "and 4 digits for the Year"
      ' MyInput = InputBox("Type in Month and year for Calendar")
       'If MyInput = "" Then Exit Sub
       'Resume
   End Sub

그다음으로  위에 데이터를 달력에 집어넣는 소스입니당....       100%  내 손으로 만든 소스... 

Sub data_input_test()
 
 MyInput = Format(Range("a1").Value, "mm yyyy")
       
      
       
       
       StartDay = DateValue(MyInput)
       ' Allow user to end macro with Cancel in InputBox.
       If MyInput = "" Then Exit Sub
       ' Get the date value of the beginning of inputted month.
       StartDay = DateValue(MyInput)
       ' Check if valid date but not the first of the month
       ' -- if so, reset StartDay to first day of month.
       If Day(StartDay) <> 1 Then
           StartDay = DateValue(Month(StartDay) & "/1/" & _
               Year(StartDay))
       End If
       
       
       dayofweek = Weekday(StartDay)
       
       
 
Data0 = Sheets(1).Range("c3:c33").Value
Data1 = Sheets(1).Range("e3:e33").Value
Data2 = Sheets(1).Range("f3:f33").Value
Data3 = Sheets(1).Range("g3:g33").Value
Data4 = Sheets(1).Range("h3:h33").Value
Data5 = Sheets(1).Range("i3:i33").Value
Data6 = Sheets(1).Range("j3:j33").Value
Data7 = Sheets(1).Range("k3:k33").Value
Data8 = Sheets(1).Range("l3:l33").Value
Data9 = Sheets(1).Range("m3:m33").Value
 
 
x = 2
y = dayofweek - 1
 
For Each a In Data1
 
    Range("A3").Offset(x, 2 * y).Value = a
 
    y = y + 1
 
    If y Mod 7 = 0 Then
 
        y = 0
        x = x + 4
    End If
Next
 
x = 3
y = dayofweek - 1
 
For Each a In Data2
 
    Range("A3").Offset(x, 2 * y).Value = a
 
    y = y + 1
 
    If y Mod 7 = 0 Then
 
        y = 0
        x = x + 4
    End If
Next
 
x = 2
y = dayofweek - 1
 
For Each a In Data3
 
    Range("A3").Offset(x, 2 * y + 1).Value = a
 
    y = y + 1
 
    If y Mod 7 = 0 Then
 
        y = 0
        x = x + 4
    End If
Next
 
 
x = 3
y = dayofweek - 1
 
For Each a In Data4
 
    If Range("A3").Offset(x, 2 * y + 1).Value = "" Then
    
    Range("A3").Offset(x, 2 * y + 1).Value = a
    End If
    
    y = y + 1
 
    If y Mod 7 = 0 Then
 
        y = 0
        x = x + 4
    End If
Next
 
x = 2
y = dayofweek - 1
 
For Each a In Data5
  If Range("A3").Offset(x, 2 * y + 1).Value = "" Then
    
    Range("A3").Offset(x, 2 * y + 1).Value = a
 
   End If
    y = y + 1
 
    If y Mod 7 = 0 Then
 
        y = 0
        x = x + 4
    End If
Next
 
 
x = 3
y = dayofweek - 1
 
For Each a In Data6
  
     If Range("A3").Offset(x, 2 * y + 1).Value = "" Then
    Range("A3").Offset(x, 2 * y + 1).Value = a
   End If
    y = y + 1
 
    If y Mod 7 = 0 Then
 
        y = 0
        x = x + 4
    End If
 
 
 
Next
 
x = 1
y = dayofweek - 1
 
 
For Each a In Data7
  
    
    
    Range("A3").Offset(x, 2 * y).Value = a
   
    y = y + 1
    
    
 
    If y Mod 7 = 0 Then
 
        y = 0
        x = x + 4
    End If
 
 
 
Next
 
x = 1
y = dayofweek - 1
 
 
For Each a In Data8
  
    
    Range("A3").Offset(x, 2 * y + 1).Value = a
   
    y = y + 1
    
    
    If y Mod 7 = 0 Then
 
        y = 0
        x = x + 4
    End If
 
 
 
Next
 
x = 0
y = dayofweek - 1
 
 
For Each a In Data9
  
   
    
    Range("A3").Offset(x, 2 * y + 1).Value = a
    y = y + 1
    
   
    
    If y Mod 7 = 0 Then
 
        y = 0
        x = x + 4
    End If
 
 
 
Next
 
 
 
End Sub

중간에 중복되는 코드를 함수로 만들어서 줄일려고했다가 귀찮아서 그냥 무한 반복.. ㅋㅋㅋㅋㅋ   

해당 파일 첨부했으니. 참고하세영.