vba - 根据日期条件删除范围

Question

我写了下面的代码，它查看 CD 列中的日期，如果任何给定单元格中的日期早于今天的日期(在 H 列中找到)，则清除该单元格中的内容。但是，我希望代码能够清除发现 TodayDate 之前的日期的行中多列(“CD:CT”)的内容。

关于如何扩展内容清除有什么建议吗？

Sub DeleteRange()

    Dim i As Long
    Dim numRowsWithVal As Long
    Dim myActiveCell As Range
    Dim todaysDate As Date

    Worksheets("Sheet1").Activate

    todaysDate = (Range("H" & Rows.Count).End(xlUp).Value)

    numRowsWithVal = (Range("CD" & Rows.Count).End(xlUp).Row)

    Set myActiveCell = ActiveSheet.Range("CD50")

    For i = 0 To numRowsWithVal

        Select Case True

            Case myActiveCell.Offset(i, 0).Value <= todaysDate

                myActiveCell.Offset(i, 0).ClearContents

        End Select

    Next
End Sub

Answer 1

您的代码中有一些错误。它应该是这样的(代码中的注释):

'ClearRange is better name for this subroutine, since it is not supposed to delete ranges but clear them instead.
Sub ClearRange()
    Dim ws As Excel.Worksheet
    Dim i As Long
    Dim numRowsWithVal As Long
    Dim myActiveCell As Range
    'Dim todaysDate As Date


    Set ws = Worksheets("Sheet1")

    'You don't have to activate a worksheet to operate on its cells.
    'Worksheets("Sheet1").Activate


    'No need for that. There is VBA built-in function that returns today date.
    'todaysDate = (Range("H" & Rows.Count).End(xlUp).Value)

    numRowsWithVal = ws.Range("CD" & ws.Rows.Count).End(xlUp).Row
    Set myActiveCell = ActiveSheet.Range("CD50")

    For i = myActiveCell.Row To numRowsWithVal



        'This is not the proper usage of Select Case.
        'In Select Case you select between many available options. Here we can
        'only two options - the date is earlier or later than today.
        'In this case regular If statement is better choice.
'        Select Case True
'            Case myActiveCell.Offset(i, 0).Value <= todaysDate
'                myActiveCell.Offset(i, 0).ClearContents
'        End Select

        If ws.Range("CD" & i).Value <= VBA.Date Then
            Call ws.Range("CD" & i & ":CT" & i).ClearContents
        End If

    Next


End Sub