Excel VBA删除日期行答案

【问题标题】：Excel VBA Deleting Rows of DatesExcel VBA删除日期行
【发布时间】：2014-03-13 19:05:14
【问题描述】：

我在 D 列中有一列日期，格式为 mm-dd-yyyy。如果 D 列中的活动单元格为空白、今天的日期或超过 8 天（即今天是 2014 年 3 月 13 日，因此它将删除，则下面是我试图用来删除整行数据的代码空白条目、今天的日期以及任何早于 2014 年 3 月 5 日的内容）。

Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).Row
Range("D" & lastrow).Select
Do
If (ActiveCell = "" Or ActiveCell = Format(Now, "mm/dd/yyyy") Or ActiveCell < Format(Now -8, "mm/dd/yyyy")) _
Then ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
Loop Until ActiveCell = "Completed Date)"

如果我使用“”符号，那么它不会删除日期为 2 月的行等。任何人都可以提出一种可行的方法，或者为什么我的不是？

【问题讨论】：

标签： vba excel delete-row

【解决方案1】：

我只是在想，但是当您在 Excel 中使用 Format 关键字时，它可能会将日期转换为文本值，因此您无法对其执行比较操作.. .

试试这个：

If (ActiveCell = "" Or (ActiveCell = Format(Now, "mm/dd/yyyy")) Or (Cdate(ActiveCell) < (Now -8))) _

实际上，与其将NOW()-8 更改为文本，不如将Activecell 转换为您可以用于比较的日期。

再一次，我没有用 VBA 做这个，但我猜它应该可以解决问题。

祝你好运！

【讨论】：

【解决方案2】：

尝试使用 DateDiff：

If not isempty(activecell)
If DateDiff("d", Now(), ActiveCell.Value) < -8 then
'do your stuff
endif
endif

【讨论】：

【解决方案3】：

将以下代码粘贴到模块中：

    Sub ScrubData()

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


        'Use a custom function to delete all blank rows in column specified
        Call DeleteAllBlankRowsInColumn("D")

        'Use VBA's Date() function to get current date (i.e. 3/13/14)
        todaysDate = Date

        'Set the cutoff date to anything older than 8 days
        cutoffDate = todaysDate - 8


        '***** Loop through all rows and clear values if rows are equal to today's date or older than 8 days ******

            'Count the number of rows with values (subtract one because sheet has headers)
            numRowsWithVal = (Range("D" & Rows.Count).End(xlUp).Row) - 1

            'Start at Range("D2")
            Set myActiveCell = ActiveSheet.Range("D2")

            For i = 0 To numRowsWithVal - 1

                Select Case True

                    'If value of cell is today's date OR older than 8 days clear the values
                    Case myActiveCell.Offset(i, 0).Value = todaysDate, myActiveCell.Offset(i, 0).Value <= cutoffDate

                        myActiveCell.Offset(i, 0).ClearContents

                    'Value is valid, do nothing
                    Case Else

                End Select

            Next

        '***********************************************************************************************************

        'Now that values are cleared, delete all blank rows again
        Call DeleteAllBlankRowsInColumn("D")

    End Sub


    Public Function DeleteAllBlankRowsInColumn(ByVal columnLetter As String)

        'Delete all blank rows in column specified (suppress errors just in case there aren't any blank cells)
        On Error Resume Next

            Columns(columnLetter).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

        'Set error handling back to normal
        On Error GoTo 0

    End Function

之前：

之后：

【讨论】：