Split weeks using Macro if user provide a specific Month

问题

I am new to macro, but have some basic idea how it works or able to write small VBA codes.

I was trying to make a weekly report. So is it possible to get the weeks in a excel sheet (start date of each week will be Monday), if i give a specific month or months (will be suing a input box which prompt to provide a start date and end date).

Like If i give October 2017 to December 2017 i will get a table something like the image i attached IMAGE

I was trying to find a solution by myself for last 1 month, but i was not able to succeed on this. If someone can help me with the code it will be really thankful. :)

回答1:

Following should help

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

See image for reference.

Input boxes

Output

来源：https://stackoverflow.com/questions/46231511/split-weeks-using-macro-if-user-provide-a-specific-month