使用vba将当前日期与格式化为“mmm-yy”的字符串日期进行比较

时间:2013-04-12 19:59:18

标签: excel vba

我的工作簿中有几张名为“user”,“52”和“Oct-13”的名称。我需要能够将当前日期与日期之后命名的工作表进行比较,例如“Oct-13”。如果当前日期是在工作表命名的日期之后的任何时间,例如10月13日,那么我需要让VBA删除工作表。我知道这样做的唯一方法是从工作表名称和当前日期中提取月份和年份并进行比较。有没有更简单的方法?我无法找到一种更简单,更有效的方式。

提前致谢。

2 个答案:

答案 0 :(得分:0)

这应该是你开始的。我试图考虑数字工作表名称(可以不应该被解释为日期,通过检查工作表名称是否包含“ - ”。)可能需要稍微改进一下。

Sub convertDates()
Dim strDate As String
Dim myDate As Date
Dim testDate As Date

testDate = DateSerial(Year(Now), Month(Now), Day(Now))

On Error GoTo InvalidDate
myDate = DateSerial(Year(strDate), Month(strDate), Day(strDate))

'You could do:
 For w = Sheets.Count To w Step -1
    strDate = Sheets(w).Name
    If InStr(1, strDate, "-", vbBinaryCompare) >= 4 Then
        If myDate < testDate Then
            Application.DisplayAlerts = False
            Sheets(w).Delete
            Application.DisplayAlerts = True
        End If
    End If
NextSheet:

 Next

Exit Sub
InvalidDate:
Err.Clear
'this worksheet's name cannot be interpreted as a date, so ignore and
' resume next
Resume NextSheet

End Sub

答案 1 :(得分:0)

Sub convertDates()
Dim strDate As String   'Formatted name of current sheet in loop
Dim deleteDate As Date  'The first day sheet is eligible for deletion
Dim currentDate As Date 'The current date as of the last time the Sub was ran
Dim sheet As Worksheet  'Used to loop through the sheets of the workbook

currentDate = DateSerial(Year(Now), Month(Now), Day(Now))

On Error GoTo InvalidDate

For Each sheet In ThisWorkbook.Worksheets
    If InStr(1, sheet.Name, "-", vbBinaryCompare) >= 4 Then
        strDate = Format(DateAdd("m", 1, sheet.Name), "yyyy,mmm")
        deleteDate = DateSerial(Year(strDate), Month(strDate), Day(strDate))
        If deleteDate <= currentDate Then
            Application.DisplayAlerts = False
            sheet.Delete
            Application.DisplayAlerts = True
        End If
    End If
NextSheet:

Next

Exit Sub
InvalidDate:
Err.Clear
'this worksheet's name cannot be interpreted as a date, so ignore and
' resume next
Resume NextSheet

End Sub