如何解决如何删除超过一个月的工作表?
我必须创建每周报告并发送给不同的客户。我有一个宏来复制每个客户所需的数据,并为新工作表命名为 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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。