自动化错误删除工作表

时间:2017-05-26 20:03:24

标签: excel vba automation spreadsheet

我有这个代码创建一个新工作表并隐藏它以保存历史数据,但我需要删除所有旧工作表,然后一个月以避免我的工作表变得太大。

我已经尝试过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

2 个答案:

答案 0 :(得分:2)

这可能是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

完全摆脱工作表循环。

答案 1 :(得分:2)

万一你去度假并且上次删除旧床单已超过两个月,你可以使用工作表名称删除超过30天的任何东西(而不仅仅是30到60天之间的东西)本身的条件:

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