我在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月份的日期行等。任何人都可以建议一种方法可行,或者为什么我的不是?
答案 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
<强>之前:强>
<强>后:强>