使用Worksheet.Change事件來添加一個新工作表

Question

我有一個單元格範圍（特別是D6：D34），其中單元格中的所有值都有一個相應的工作表。但是，由於我在添加新值（或更改單元格值）時只是手動添加工作表，因此我正考慮使用Private Sub Worksheet_Change(ByVal Target as Range)來允許在單元更改時自動創建工作表。這是我試圖使用的，但現在我得到一個錯誤，「表名已經存在」，因爲它向下看整列。我嘗試過使用錯誤處理來跳過存在的錯誤處理，但它最終會移動到下一個檢查，但將「Sheet1」和「Sheet2」等離開。關於如何設置它的任何建議？

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim hlValue As Range 
For Each hlValue In Sheets(1).Range("D6:D34") 
    ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count) 
    ActiveSheet.Name = hlValue 
Next 
End Sub 

我還應該說如果其中一個單元格值被刪除，工作表也應該被刪除。某種If CellValue <> Exist, Delete？我找不到任何東西用來檢查它是否存在除了花哨的功能。我應該使用其中之一嗎？

編輯：好的，我現在有這個。這應該就夠了。

Private Sub Worksheet_Change(ByVal Target As Range) 
Application.DisplayStatusBar = True 
Application.ScreenUpdating = False 'Run faster 
Application.DisplayAlerts = False 'Just in case 
Dim shtName As Variant 
For Each shtName In Sheets(1).Range("D6:D34") 
If WorksheetExists((shtName)) Then 
'do nothing 
Else 
    ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count) 
    ActiveSheet.Name = shtName 
Application.StatusBar = "Creating new sheet for " & shtName 'Just in case it's running slowly 
Sheets("Admin").Select 
End If 
Next 
Application.StatusBar = "READY" 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
End Sub 
Function WorksheetExists(sName As String) As Boolean 
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)") 
End Function 

Answer 1

我找不到任何用來檢查它是否存在，除了花哨的功能。我應該使用其中之一嗎？

是的，你應該！工作表是Collection對象的一部分，並且沒有內置的可以查詢的Exists（或類似）方法。這樣的函數不是很花哨:)，如果你不熟悉這個函數和/或調用其他子程序，這將是一個很好的介紹。

在它的最簡單的：

Function SheetExists(sName As String) As Boolean 
    Dim w as Worksheet 
    On Error Resume Next 
    Set w = Worksheets(sName) 
    SheetExists = Not w Is Nothing 
End Function 

這是如何工作：

If SheetExists("sheet1") Then 
    'Do something 
Else 
    'Sheet doesn't exist, so do something else 
End If 

你傳遞一個字符串值功能sName。無論此功能是否存在，該功能都將返回True或False。

首先，函數SheetExists嘗試按名稱將Worksheet變量設置爲指定的工作表。如果工作表名稱不存在，這可能會失敗，所以我們將這些知識與Resume Next聲明一起使用。在發生錯誤的情況下，w將不會被分配工作表並保持爲Nothing，然後我們使用布爾表達式（Not w Is Nothing）作爲函數的返回值。如果工作表確實存在，則w不會爲空，因此該功能將返回True，如果工作表不存在，w將爲Nothing，因此該函數將返回False。

上面的函數只使用ActiveWorkbook，所以這個更健壯的版本也允許你指定一個父工作簿。

Function SheetExists(sName As String, Optional wb as Workbook = Nothing) As Boolean 
    'This function checks whether worksheet 'sName' exists in 
    ' workbook object 'wb'. If no parameter is passed for 'wb' then 
    ' assume to use the ActiveWorkbook 
    Dim w as Worksheet 
    If wb Is Nothing Then Set wb = ActiveWorkbook 
    On Error Resume Next 
    Set w = wb.Worksheets(sName) 
    SheetExists = Not w Is Nothing 
End Function 

NB：有地方On Error Resume Next並不令人難以接受的比較少的情況，但在一個非常小的和具體的功能用這個，有一個明確的目標和期望是OK。

另外，蠻力迭代通過收集的物品也可以用來查詢存在的集合，這不依賴於On Error Resume Next：

Function SheetExists2(sName as String) As Boolean 
    Dim ws as Worksheet, ret as Boolean 
    For Each ws In ActiveWorkbook.Worksheets 
     If ws.Name = sName Then 
      ret = True 
      Exit For 
     End If 
    Next 
    SheetExists2 = ret 
End Function