使用 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

注意：On Error Resume Next 不被皱眉的情况相对较少，但在一个非常小的和特定的函数中使用它，具有明确的目的和期望是可以的。

或者，对集合的 Items 的暴力迭代也可以用于查询集合是否存在，这不依赖于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