自动化错误删除 Sheet

Question

我有这段代码可以创建一个新的 sheet 并隐藏它以保留历史数据，但我需要删除所有 sheet 一个月之前的代码以避免我的工作sheet 变得太大了。

我已经尝试从 30 数到 60 和 60 到 30。

Sub Historico_DAR()

' Historico_DAR Macro

    Dim LDate, PDate As String
    Dim ws As Worksheet
    Dim wks As Worksheet
    Dim i As Integer

    LDate = Format(DateSerial(Year(Date), Month(Date), Day(Now)), "dd-mmm-yy")
    PDate = Format(DateSerial(Year(Date), Month(Date), Day(Now) - 30), "dd-mmm-yy")
    Worksheets("Sheet69").Range("A1").Value = PDate

'CODE Giving Atomation Error, the rest is OK

     For Each wks In Worksheets
       For i = 60 To 30 Step -1
         PDate = Format(DateSerial(Year(Date), Month(Date), Day(Now) - i), "dd-mmm-yy")
           If wks.Name = PDate Then
              Application.DisplayAlerts = False
              Sheets(PDate).Delete
              Application.DisplayAlerts = True
           End If
       Next
    Next

'End of the code giving me problems

    For Each ws In Worksheets
       If ws.Name = LDate Then
        Application.DisplayAlerts = False
        Sheets(LDate).Delete
        Application.DisplayAlerts = True
        End If
    Next

    Sheets("Atual").Select
    Sheets("Atual").Copy Before:=Sheets(9)
    Worksheets("Atual (2)").Range("A1:P476").Value = Worksheets("Atual").Range("A1:P476").Value
    Sheets("Atual (2)").Select
    Sheets("Atual (2)").Name = LDate
    Sheets(LDate).Visible = False
End Sub

Answer 1

这可能是 On Error Resume Next 真正有用的时候。

On Error Resume Next
Application.DisplayAlerts = False
For i = 60 To 30 Step -1
    PDate = Format(Date - i, "dd-mmm-yy")
    Sheets(PDate).Delete
Next i
Application.DisplayAlerts = True
On Error GoTo 0

完全摆脱工作表循环。

Answer 2

以防万一您休假并且距离上次删除旧的 sheets 已经超过两个月，您可以删除超过 30 天的任何内容（而不仅仅是 30 到 60 天之间的内容） )，通过在条件中使用 sheet 名称本身：

For Each wks In Worksheets
    If IsDate(wks.Name) Then
        If (Date() - 30) > CDate(wks.Name) Then
            Application.DisplayAlerts = False
            wks.Delete
            Application.DisplayAlerts = True
        End If
    End If
Next

这可以通过扩展 If

与您的下一个循环相结合

For Each wks In Worksheets
    If IsDate(wks.Name) Then
        If (Date() - 30) > CDate(wks.Name) Or Date() = CDate(wks.Name) Then
            Application.DisplayAlerts = False
            wks.Delete
            Application.DisplayAlerts = True
       End If
    End If
Next

另请注意

LDate = Format(DateSerial(Year(Date), Month(Date), Day(Now)), "dd-mmm-yy")
PDate = Format(DateSerial(Year(Date), Month(Date), Day(Now) - 30), "dd-mmm-yy")

可以简化为

LDate = Format(Date(), "dd-mmm-yy")
PDate = Format(Date() - 30, "dd-mmm-yy")

或

LDate = Format(Now(), "dd-mmm-yy")
LDate = Format(Now() - 30, "dd-mmm-yy")

自动化错误删除 Sheet

Automation Error deleting Sheet

excel

automation

vba

spreadsheet