我的代码如下。我正在尝试根据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")
答案 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
进行了测试,以查看是否已存在具有该名称的工作表。在下一个循环迭代中,此指针仍指向最后创建的工作表!因此,在创建第一张纸之后,测试将始终为正。要修复,请在测试之前重置指针。