删除输入月份之外的日期

Question

我正在创建一个用于格式化新时间表的子程序。我需要它删除输入月份以外的日期（在这种情况下，是2020年6月）。该代码会自动填充第一天之后的接下来的30天，该日期涵盖一个月中最多的几天（31天），但是如果输入的月份少于31天，还会添加下个月第一天的日期。这是我的代码：

Sub Calendar_Genorator3()
Dim WS As Worksheet
Dim MyInput As Variant
Dim StartDay As Variant
Dim DayofWeek As Variant
Dim CurYear As Variant
Dim CurMonth As Variant
Dim FinalDay As Variant
Dim Cell As Range
Dim RowCell As Long
Dim ColCell As Long
Dim Day1 As Range

Set WS = ActiveWorkbook.ActiveSheet
WS.Range("A1:R100").Clear

MyInput = InputBox("Type in Month and year for Calendar ")
    If MyInput = "" Then Exit Sub
       ' Get the date value of the beginning of inputted month.
       StartDay = DateValue(MyInput)
       ' Check if valid date but not the first of the month
       ' -- if so, reset StartDay to first day of month.
       If Day(StartDay) <> 1 Then
           StartDay = DateValue(Month(StartDay) & "/1/" & _
               Year(StartDay))
       End If

       'Set headers
       Range("a1").Value = Application.Text(MyInput, "mmmm") & " Time Sheet"
       Range("a2") = "Day"
       Range("c2") = "Time In"
       Range("d2") = "Time Out"
       Range("e2") = "Hours"
       Range("f2") = "Notes"
       Range("g2") = "Overtime"

       'Set weekdays
       Range("a3") = "Sunday"
       Range("a4") = "Monday"
       Range("a5") = "Tuesday"
       Range("a6") = "Wednesday"
       Range("a7") = "Thursday"
       Range("a8") = "Friday"
       Range("a9") = "Saturday"

       DayofWeek = Weekday(StartDay)
       ' Set variables to identify the year and month as separate variables.
       CurYear = Year(StartDay)
       CurMonth = Month(StartDay)
       ' Set variable and calculate the first day of the next month.
       FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
       ' Place a "1" in cell position of the first day of the chosen month based on DayofWeek.
       Select Case DayofWeek
           Case 1
               Range("b3").Value = 1
           Case 2
               Range("b4").Value = 1
           Case 3
               Range("b5").Value = 1
           Case 4
               Range("b6").Value = 1
           Case 5
               Range("b7").Value = 1
           Case 6
               Range("b8").Value = 1
           Case 7
               Range("b9").Value = 1
       End Select

'Loop through range b3:b44 incrementing each cell after the "1" cell.
For Each Cell In Range("b3:b44")
    RowCell = Cell.Row
    ColCell = Cell.Column
    'Do if "1" is in column B or 2.
        If Cell.Row = 1 And Cell.Column = 2 Then
        ' Do if current cell is not in 1st column.
            ElseIf Cell.Row <> 1 Then
                If Cell.Offset(-1, 0).Value >= 1 Then
                    Cell.Value = Cell.Offset(-1, 0).Value + 1
                    ' Stop when the last day of the month has been entered.
                    If Cell.Value > (FinalDay - StartDay) Then
                        Cell.Value = ""
                        ' Exit loop when calendar has correct number of days shown.
                        Exit For
                    End If
                End If
        End If
Next

For Each Cell In Range("b3:b9")
    If Cell.Value = "" Then
        Cell.EntireRow.Clear
    End If
Next
'Clears rows without dates

For Each Cell In Range("b3:b9")
    If Cell.Value = "" Then
        Cell.EntireRow.Delete
    End If
Next
'Deletes top rows without dates; needs a loop to successfully delete all empty rows

    Range("b2") = "Date"
    'Added "Date" in later so date insert works

Set Day1 = WS.Cells.Find(What:="1", LookIn:=xlValues, _
        lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False)
        'Find start day, which is day 1
        If Not Day1 Is Nothing Then
            Day1.Value = Application.Text(MyInput, "mmm-d")
        End If

        With Day1
            Day1.AutoFill Destination:=Range("B3:B33"), Type:=xlFillDefault
        End With

'These final lines of code don't delete ranges with dates that fall outside of the inputted month, because FinalDay doesn't refer to the last day of the month. I need to come up with something that refers to the last day of the month. 
        FinalDay.Select
        With Selection
                Cell.Offset(-1).End(xlDown).EntireRow.Delete
        End With
End Sub

这是此代码的输出。关于如何删除日期不在输入月份内的行有任何想法吗？我也乐于以完全不同的方式编写此子程序。我这样做是因为我将其基于MS模板代码。

Answer 1

您的努力是非常好的。在下面的代码中，我采用了不同的方法。希望您会喜欢。我添加了很多评论。

Sub Calendar_Generator()
    ' 046

    Dim Ws          As Worksheet
    Dim MyInput     As String               ' InputBox generates a string
    Dim StartDay    As Date                 ' this must be date
    Dim Sp()        As String               ' working array
    Dim i           As Integer              ' looping index
    Dim R           As Long                 ' row counter

    Set Ws = ActiveWorkbook.ActiveSheet     ' not a good idea. Always specify the tab by name!
    Ws.Range("A1:R100").Clear

    Do
        MyInput = InputBox("Enter the start date for the Calendar:")
        If MyInput = "" Then Exit Sub
    Loop While Not IsDate(MyInput)          ' repeat if entry isn't recognized as a date

    ' Set the date value of the beginning of inputted month.
    ' -- regardless of the day the user entered, even if missing
    StartDay = DateSerial(Year(CDate(MyInput)), Month(CDate(MyInput)), 1)

    'Set headers
    Range("a1").Value = Format(StartDay, "mmmm") & " Time Sheet"
    Sp = Split("Day,Date,Time In,Time Out,Hours,Notes,Overtime", ",")
    For i = 0 To UBound(Sp)
        Ws.Cells(2, 1 + i).Value = Sp(i)     ' always specify the worksheet
    Next i

    ' fill the days for the selected month
    ' == the last day of a month is always the day before the first of the next
    '    here deducting 2 to count from 0
    For R = 0 To Day(DateAdd("m", 1, StartDay) - 2)
        With Ws.Cells(3 + R, 2)
            .Value = StartDay + R
            .NumberFormat = "d-mmm"
            .Offset(, -1).Value = StartDay + R
            .Offset(, -1).NumberFormat = "dddd"
        End With
    Next R
End Sub

如果查看声明，则六分之四（共三分之二）用于代码管理。这表明了我的工作重点，结果是代码更短，效率更高。这大部分是通过遵循一条简单的规则（宏记录器似乎并不知道）实现的：使用单元寻址语法来寻址单元，而使用范围寻址语法仅用于寻址单元的范围。单元坐标很容易计算并可以循环使用。