Question

我是宏的新手，但有一些基本的想法，它是如何工作的或能够编写小的VBA代码。

我试图每周报道一次。因此，如果我给出一个特定的月份或月份（将起诉一个提示提供开始日期和结束日期的输入框），那么可以在excel表格中获得周数（每周的开始日期将是星期一）。

喜欢如果我在2017年10月到2017年12月之间给我一张桌子，就像我附上的图片一样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

参见图片以供参考。

输入框

输出

如果用户提供特定的月

1 个答案: