Excel VBA删除日期行

时间:2014-03-13 19:05:14

标签: vba excel-vba delete-row excel

我在D列中以mm-dd-yyyy格式列出了一列日期。下面是我试图用来删除整行数据的代码,如果列D中的活动单元格为空白,今天的日期或超过8天(即今天是3/13/14,所以它会擦除空白条目,今天的日期以及任何超过3/5/14的任何内容。

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)"

如果我使用“&lt;”符号,它基本上擦除了一切,如果我使用“&gt;”符号,然后它不会删除2月份的日期行等。任何人都可以建议一种方法可行,或者为什么我的不是?

3 个答案:

答案 0 :(得分:0)

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

请改为尝试:

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

实际上,不是将NOW()-8更改为文字,而是将Activecell转换为可用于比较的日期。

同样,我没有用VBA做到这一点,但我猜测它应该可以解决这个问题。

祝你好运!!

答案 1 :(得分:0)

尝试使用 DateDiff

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

答案 2 :(得分:0)

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

    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

<强>之前:

Before

<强>后:

After