사용자가 특정 달을 제공하는 경우 매크로를 사용하여 주 분할

Question

나는 매크로가 처음이지만 작은 VBA 코드를 작성하는 방법이나 기본적인 아이디어가 있습니다.

주간 보고서를 작성하려고했습니다. 그래서 특정 달 또는 개월 (시작 날짜와 종료 날짜를 제공하라는 입력 상자를 고소 할 것입니다)을 주면 엑셀 시트 (매주의 시작 날짜는 월요일이 될 것입니다)에서 주를 얻는 것이 가능합니다.

난 12 월 2017 2017년 10월주는 경우에 나는

내가 지난 1 개월 혼자 해결책을 찾기 위해 노력했다 IMAGE을 첨부 이미지와 같은 테이블 무언가를 얻을 것이다,하지만 난 성공할 수 없습니다처럼 이에. 누군가가 코드를 도와 주면 정말로 감사 할 것입니다. :)

Answer 1

참조

Sub Demo() 
    Dim intDay As Integer, firstIter As Integer 
    Dim startMonth As Date, endMonth As Date 
    Dim str As String 
    Dim IsStartMonth As Boolean, IsEndMonth As Boolean 
    Dim rng As Range, rng1 As Range, rng2 As Range 
    Dim i As Long 
    Dim ws As Worksheet 

    Application.ScreenUpdating = False 
    firstIter = 1 
    Set ws = ThisWorkbook.Sheets("Sheet4") 'change Sheet4 to your sheet 
    IsStartMonth = False 
    IsEndMonth = False 
    Do 
     If Not IsStartMonth Then 
     'get start date 
      str = InputBox("Enter Start Date in month-year format " & vbCrLf & "(like Sep 2017 or September 2017)", "Date") 
      If IsDate(str) Then   'if entery is valid date 
       startMonth = str 
       IsStartMonth = True 
      ElseIf IsEmpty(str) Then 'if nothing is entered 
       IsStartMonth = True 
      ElseIf StrPtr(str) = 0 Then 'user clicks close 
       IsStartMonth = True 
       Exit Sub 
      Else      'display input box again 
       Call MsgBox("Enter a valid date", vbCritical + vbOKOnly, "Date Only") 
      End If 
     Else 
     'get end date 
      str = InputBox("Enter End Date in month-year format " & vbCrLf & "(like Sep 2017 or September 2017)", "Date") 
      If IsDate(str) Then   'if entery is valid date 
       endMonth = DateAdd("d", -1, DateAdd("m", 1, str)) 
       IsEndMonth = True 
      ElseIf IsEmpty(str) Then 'if nothing is entered 
       IsEndMonth = True 
      ElseIf StrPtr(str) = 0 Then 'user clicks close 
       IsEndMonth = True 
       Exit Sub 
      Else      'display input box again 
       Call MsgBox("Enter a valid date", vbCritical + vbOKOnly, "Date Only") 
      End If 
     End If 
    Loop Until IsStartMonth And IsEndMonth 

    Set rng = ws.Range("B2") 
    ws.Range("A2") = "Dates" 
    Set rng1 = rng.Offset(-1, i) 
    intDay = intDay + 1 

    Do 
     If Format(startMonth + intDay, "ddd") = "Mon" Then  'check whether date is Monday 
      rng.Offset(-1, i).Value = MonthName(Format(startMonth + intDay, "m")) 
      rng.Offset(0, i).Value = Format(startMonth + intDay, "d") 'display monday dates 
      i = i + 1 
      intDay = intDay + 7 

      'merge cells in Row 1 
      If rng1.Value = rng.Offset(-1, i - 1).Value Then 
       If firstIter <> 1 Then 
        rng.Offset(-1, i - 1).Value = "" 
       End If 
       firstIter = 0 
       With Range(rng1, rng.Offset(-1, i - 1)) 
        .Merge 
        .HorizontalAlignment = xlCenter 
       End With 
      Else 
       Set rng1 = rng.Offset(-1, i - 1) 
      End If 

     Else 
      intDay = intDay + 1 
     End If 
    Loop Until CDate(startMonth + intDay) > CDate(endMonth) 'loop till start date is less then end date 
Application.ScreenUpdating = True 
End Sub 

참조 이미지를 도움이 될 것입니다 다음.

입력 상자

출력