Excel 2007로 일정을 잡는 매크로

Question

나는 한 장의 달력을 만들고 싶다. 다른 날 (근무 시간 중에 확산되는 다른 칼럼)에 따라 다른 시트의 초기 날짜를 가져와야한다. 그래서이 예를 들어

date hours 
17/02/2012 8 
20/02/2012 50 
20/02/2012 37 
13/03/2012 110 

으로되어해야

가

date hours 
17/02/2012 8 
20/02/2012 8 
21/02/2012 8 
22/02/2012 8 
23/02/2012 8 
24/02/2012 8 
27/02/2012 8 
28/02/2012 2 
20/02/2012 8 
21/02/2012 8 
22/02/2012 8 
23/02/2012 8 
24/02/2012 3 
13/03/2012 8 
14/03/2012 8 
15/03/2012 8 
16/03/2012 8 
19/03/2012 8 
20/03/2012 8 
21/03/2012 8 
22/03/2012 8 
23/03/2012 8 
26/03/2012 8 
27/03/2012 8 
28/03/2012 8 
29/03/2012 8 
30/03/2012 6 

처음 일 (2 월 17 일)은 금요일이고 그 다음에 셀 (8 시간)로 채워진다. 다음 매크로는 두 번째 행을 가져와야하고, 2 월 20 일 (월요일)부터 시작하여 값 (37 시간)이 다음 근무일에 보급 될 때까지 완료해야합니다. 이런 식으로 나는 생산을위한 노동자 달력을 가지고있다. 누군가 나를 도울 수 있니? 미리 감사드립니다.

Answer 1

예제 데이터로 찾는 결과가 생성됩니다.

Option Explicit 
Sub GenerateCalendar() 

    Dim DateCrnt As Date 
    Dim DayOfWeekCrnt As Long 
    Dim HoursToPlace As Long 
    Dim RowDestCrnt As Long 
    Dim RowSrcCrnt As Long 
    Dim RowSrcLast As Long 
    Dim SrcWork() As Variant 

    ' Assume source data starts in row 2 of columns A and B of Worksheet Calendar 1 
    With Worksheets("Calendar 1") 
    ' Find last used row in column A 
    RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row 
    SrcWork = .Range(.Cells(2, "A"), .Cells(RowSrcLast, "B")).Value 
    End With 

    ' SrcWork is now a 2D array containing the data from Calendar1. 
    ' Dimension 1 holds the rows. Dimension 2 holds to columns. 

    ' Initialise control variable for SrcWork 
    RowSrcCrnt = 1 
    DateCrnt = SrcWork(RowSrcCrnt, 1) 
    HoursToPlace = SrcWork(RowSrcCrnt, 2) 
    RowSrcCrnt = 2 

    ' Assume output data is to be placed in in Worksheet Calendar 2 in columns 
    ' A and B starting at row 2 
    RowDestCrnt = 2 

    With Worksheets("Calendar 2") 
    Do While True 
     ' DateCrnt identifies the next date to output. 
     ' HoursToPlace identifies the unplaced hours 
     With .Cells(RowDestCrnt, 1) 
     .Value = DateCrnt 
     .NumberFormat = "ddd d mmm yyy" 
     End With 
     If HoursToPlace > 8 Then 
     .Cells(RowDestCrnt, 2).Value = 8 
     HoursToPlace = HoursToPlace - 8 
     Else 
     .Cells(RowDestCrnt, 2).Value = HoursToPlace 
     HoursToPlace = 0 
     End If 
     RowDestCrnt = RowDestCrnt + 1 
     If HoursToPlace = 0 Then 
     ' No more hours to place from last row of SrcWork 
     If RowSrcCrnt > UBound(SrcWork, 1) Then 
      ' There are no used rows in SrcWork. Finished 
      Exit Do 
     End If 
     ' Extract next row from source data. 
     DateCrnt = SrcWork(RowSrcCrnt, 1) 
     HoursToPlace = SrcWork(RowSrcCrnt, 2) 
     RowSrcCrnt = RowSrcCrnt + 1 
     Else 
     ' More hours to place. Set DateCrnt to the next weekday. 
     Do While True 
      DateCrnt = DateAdd("d", 1, DateCrnt) ' Add 1 day to DateCrnt 
      DayOfWeekCrnt = Weekday(DateCrnt) 
      If DayOfWeekCrnt >= vbMonday And DayOfWeekCrnt <= vbFriday Then 
      ' Have week day 
      Exit Do 
      End If 
     Loop 
     End If 
    Loop 
    End With 

End Sub