宏-根據日期刪除行

Question

我對VBA和Excel中的宏非常陌生。 我有一個很大的Excel電子表格，其中A列保存日期。 我正在嘗試刪除值小於特定日期的行，這是我到目前為止提出的。

Sub DELETEDATE()
Dim x As Long
For x = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
Debug.Print Cells(x, "A").Value
If CDate(Cells(x, "A")) < CDate("01/01/2013") Then
Cells(i, "A").EntireRow.Delete
End If
Next x
Next i
End Sub

我收到沒有錯誤的Next ...有人可以幫忙嗎？

Answer 1

這很適合使用Range的.AutoFilter屬性。 以下腳本包含對每個步驟的注釋：

Option Explicit
Sub DeleteDateWithAutoFilter()

Dim MySheet As Worksheet, MyRange As Range
Dim LastRow As Long, LastCol As Long

'turn off alerts
Application.DisplayAlerts = False

'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Sheet1")

'identify the last row in column A and the last col in row 1
'then assign a range to contain the full data "block"
With MySheet
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastCol = .Range("A" & .Columns.Count).End(xlToLeft).Column
    Set MyRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With

'apply autofilter to the range showing only dates
'older than january 1st, 2013, then deleting
'all the visible rows except the header
With MyRange
    .AutoFilter Field:=1, Criteria1:="<1/1/2013"
    .SpecialCells(xlCellTypeVisible).Offset(1, 0).Resize(.Rows.Count).Rows.Delete
End With

'turn off autofilter safely
With MySheet
    .AutoFilterMode = False
    If .FilterMode = True Then
        .ShowAllData
    End If
End With

'turn alerts back on
Application.DisplayAlerts = True

End Sub

在一個簡單的示例（在此圖片的“ Sheet1”上）上運行此代碼，如下所示：

將刪除日期早於1/1/2013的所有行，從而得到以下結果：

Answer 2

回答你的問題

我收到沒有錯誤的下一個

問題是您試圖在i上循環，但尚未打開For i循環。 當您在任何調用Loop或條件的代碼（例如If ）下縮進代碼時，它變得顯而易見

Sub DELETEDATE()
Dim x As Long
    For x = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
        Debug.Print Cells(x, "A").Value
        If CDate(Cells(x, "A")) < CDate("01/01/2013") Then
            Cells(i, "A").EntireRow.Delete 'i has no value so Cells(0, "A") is ??
        End If
    Next x
    Next i 'where is the For i = ... in this code?
End Sub

在編寫代碼時，我嘗試：

• 如果需要，請立即輸入結束命令。 所以鍵入If...Then ，按[ENTER] ，鍵入End If ，按[HOME] ，按[ENTER] ，按[UP ARROW]然后按[TAB]到正確的位置以編寫條件代碼，這樣任何人都可以能夠輕松閱讀和理解。
• 始終在每個模塊的頂部使用Option Explicit強制執行變量聲明。

有關根據條件刪除行的提示如果您從頂部開始並進行排序，則每次刪除一行時，計數器都會有效地移至所刪除行下方兩行的單元格中，因為緊接在已刪除行下方的行會向上移動（即完全未經測試）。

最有效的方法是從底部或行向上循環：

Sub DELETEDATE()
Dim x As Long
    For x = [a1].SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
        Debug.Print Cells(x, "A").Value
        If CDate(Cells(x, "A")) < CDate("01/01/2013") Then
            Cells(x, "A").EntireRow.Delete 'changed i to x
        End If
    Next x
End Sub

這樣，您要測試的下一行已保留-您僅將下面的行向上移動了1，並且較早地測試了該行。

Answer 3

請嘗試這個

Sub DELETEDATE()
Dim x As Long
last = Range("A65536").End(xlUp).Row
For x = 1 To last
    Debug.Print Cells(x, "A").Value
    check:
    If x <= last Then
        If Trim(CDate(Cells(x, "A"))) <= Trim(CDate("7/29/2013")) Then
            last = last - 1
            Cells(x, "A").EntireRow.Delete
            GoTo check
        End If
    End If
Next x
End Sub

Answer 4

由於調試器突出顯示的代碼，由於某種原因，您還有一個額外的Next i 。 請嘗試以下方法：

Sub DELETEDATE()
Dim x As Long
For x = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
Debug.Print Cells(x, "A").Value
If CDate(Cells(x, "A")) < CDate("01/01/2013") Then
Cells(i, "A").EntireRow.Delete
End If
Next x
End Sub