Excel自动化错误 - 格式化日期

时间:2015-06-21 20:30:39

标签: excel vba excel-vba

我的代码如下。我正在尝试根据Date列中的唯一值创建新工作表。如果我没有正确格式化日期,

由于/,我收到了无效的工作表名称错误。但是,在尝试格式化日期以避免此错误时,我收到自动化错误,宏终止于我在此处发布的最后一行。

请帮忙。 :)

Sub Analyze()
Dim DateColumn As Range
Dim theDate As Range
Dim theNextDate As Range
Dim theWorksheet As Worksheet
Dim thenewWorksheet As Worksheet
Const DateColumnCell As String = "Date"
Set theWorksheet = Sheets("Main")
Set DateColumn = theWorksheet.UsedRange.Find(DateColumnCell, , xlValues, xlWhole)

'Make sure you found something
If Not DateColumn Is Nothing Then
    'Go through each cell in the column
    For Each theDate In Intersect(DateColumn.EntireColumn, theWorksheet.UsedRange).Cells
        'skip the header and empty cells
        If Not IsEmpty(theDate.Value) And theDate.Address <> DateColumn.Address Then
            'see if a sheet already exists
            On Error Resume Next
                Set thenewWorksheet = theWorksheet.Parent.Sheets(DateColumn.Value)
            On Error GoTo 0


            'if it doesn't exist, make it
            If thenewWorksheet Is Nothing Then
                Set thenewWorksheet = theWorksheet.Parent.Worksheets.Add
                thenewWorksheet.Name = Format(theDate.Value, "Long Date")

1 个答案:

答案 0 :(得分:1)

首先,您在

中使用了错误的值
    Set thenewWorksheet = theWorksheet.Parent.Sheets(DateColumn.Value)

这应该是theDate.Value,而不是DateColumn.Value

但是为了处理无效格式错误,我建议您对代码进行扩展:

        Dim NewSheetName As String

        For Each theDate In Intersect(DateColumn.EntireColumn, theWorksheet.UsedRange).Cells
        'skip the header and empty cells
        If Not IsEmpty(theDate.Value) And theDate.Address <> DateColumn.Address Then
            'see if a sheet already exists
            NewSheetName = Format(theDate.Value, "yyyy-mm-dd")
            Set thenewWorksheet = Nothing
            On Error Resume Next
                Set thenewWorksheet = theWorksheet.Parent.Sheets(NewSheetName)
            On Error GoTo 0

            'if it doesn't exist, make it
            If thenewWorksheet Is Nothing Then
                Set thenewWorksheet = theWorksheet.Parent.Worksheets.Add
                thenewWorksheet.Name = NewSheetName
            End If
        End If
    Next

使用日期的自定义格式,以确保所有包含的字符在工作表名称中是合法的。其次,在现有工作表的名称中查找相同字符串作为新工作表的预期名称。

编辑

修正了另一个错误:指针thenewWorksheet针对Nothing进行了测试,以查看是否已存在具有该名称的工作表。在下一个循环迭代中,此指针仍指向最后创建的工作表!因此,在创建第一张纸之后,测试将始终为正。要修复,请在测试之前重置指针。