如何删除超过一个月的工作表？

问题描述

我必须创建每周报告并发送给不同的客户。我有一个宏来复制每个客户所需的数据，并为新工作表命名为 mmm-dd-yyyy（例如 2021 年 3 月 1 日）。

我只想保留最后四个星期的床单。我找到了删除超过一个月的任何工作表的代码，但它不起作用。

我有隐藏的床单（主人和联系人），应该保持原样。将来我可能会添加提前期表，该表对客户可见，不应删除。

Sub del_by_date2() 

Dim tagad As Date 
Dim pirms1 As Date 

tagad = Now() 
pirms1 = DateAdd("m",-1,tagad) 
test = Format(pirms1,"mmm-dd-yyyy") 

Application.displayAlerts = False 

For Each Worksheet In ThisWorkbook.Sheets 

If Right(Worksheet.Name,4) < Right(test,4) Then Worksheet.Delete
 
ElseIf Right(Worksheet.Name,4) = Right(test,4) _ And Left(Worksheet.Name,2) <= Left(test,2) 

Then 
Worksheet.Delete 
End If 

Next 

Application.displayAlerts = True 

End Sub

解决方法

请尝试一下，看看它是否适合您。

Sub del_by_date2()
Dim tagad   As Date
Dim pirms1  As Date
Dim WS      As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

tagad = Date
pirms1 = DateAdd("m",-1,tagad)

For Each WS In ThisWorkbook.Sheets
    If IsDate(WS.Name) Then
        If CDate(WS.Name) < pirms1 And WS.Visible = True Then WS.Delete
    End If
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

,

试试，

Sub del_by_date2()
    Dim Ws      As Worksheet
    Dim vName() As String
    Dim DayBefore4W As Date
    Dim n As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
   
    DayBefore4W = DateAdd("ww",-4,Date)
    
    For Each Ws In ThisWorkbook.Sheets
        If IsDate(Ws.Name) Then
            'If DateValue(Ws.Name) < DayBefore4W And Ws.Visible = True Then
            If CDate(Ws.Name) < DayBefore4W And Ws.Visible = True Then
                n = n + 1
                ReDim Preserve vName(1 To n)
                vName(n) = Ws.Name
            End If
        End If
    Next
    Debug.Print Join(vName,vbCrLf)
    If n Then
        Sheets(vName).Delete
    End If
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub