ユーザーが特定の月を指定した場合、マクロを使用して週を分割する

Question

マクロには新しいですが、小さなVBAコードをどのように書くことができるか、基本的な考え方があります。

私は毎週レポートを作成しようとしていました。それで、もし特定の月または月（開始日と終了日を提供するように促す入力ボックスを訴える）をすれば、Excelシート（週の開始日は月曜日）で週を得ることが可能です。

私は2017年12月に2017年10月与えた場合と同じように私はIMAGE

を添付画像のようなテーブルの何かを得るだろう、私は最後の1ヶ月間自分で解決策を見つけるためにしようとしていたが、私は成功することができませんでしたこれに。誰かがコードを手伝ってくれたら本当に感謝しています。 :)続き

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 

は、参照用の画像を参照してください。

入力ボックス

出力