Excel VBA刪除日期行

Question

我在mm-dd-yyyy格式的D列中有一列日期。下面是我試圖用來刪除整行數據的代碼，如果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)" 

如果我使用了「<」符號，它會刪除所有內容基本上，如果我使用「>」符號，那麼它不會刪除的行較2月份日期等任何人都可以提出一個將工作的方法，或爲什麼我的不是？

Answer 1

我只是在想我的頭頂，但在Excel中使用Format關鍵字的那一刻，它可能會將日期轉換爲文本值，因此您無法對其執行比較操作...

試試這個：

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

在效果上，而不是改變NOW()-8於文字，轉換Activecell你可以使用比較起見日期。

同樣，我沒有這樣做與VBA，但我猜它應該做的伎倆。

祝你好運！

Answer 2

嘗試使用則DateDiff：

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

Answer 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 

前：

後：