如果用户提供特定月份，则使用宏拆分周

Question

我是宏的新手，但对它的工作原理有一些基本了解，或者能够编写小 VBA 代码。

我正在尝试制作每周报告。那么是否有可能在 excel sheet 中获得周数（每周的开始日期为星期一），如果我给出一个或多个特定月份（将起诉提示提供的输入框开始日期和结束日期）。

赞如果我将 2017 年 10 月设为 2017 年 12 月，我将得到 table 类似于我附上的图片 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

查看图片以供参考。

输入框

输出

如果用户提供特定月份，则使用宏拆分周

Split weeks using Macro if user provide a specific Month

excel

vba

report