2015-06-21 85 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測試,以查看是否具有該名稱的表已經存在。在下一次循環迭代中,這個指針仍然指向最後創建的表單!所以在創建第一張紙後,測試總是正面的。要修復,請在測試之前重置指針。