2015-06-21 89 views
0

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

由于/,我得到一个无效的表名错误。但是,当试图格式化日期以避免出现此错误时,出现自动化错误,并且宏终止于我在此发布的最后一行。

请帮忙。 :)所有的

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

运行此命令时'theDate'的值是多少? –

+1

你永远不会检查'工作表(格式(theDate.Value,“长日期”))'是否存在。这可能是问题吗? –

+1

我很难看到问题出在哪里,但我注意到你正在使用'DateColumn.Value'进行测试,它会返回一个未格式化的日期,例如2015年1月1日,但是你使用长格式命名表单,例如,“2015年1月1日星期一”。这些比较看起来像他们一直是错误的。现在是适应F8并在本地窗口中检查变量的好时机。 –

回答

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 

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

编辑:

固定另一个bug:指针thenewWorksheet抵抗Nothing测试,以查看是否具有该名称的表已经存在。在下一次循环迭代中,这个指针仍然指向最后创建的表单!所以在创建第一张纸后,测试总是正面的。要修复,请在测试之前重置指针。