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并不令人不满，但在一个非常小的特定功能中使用它，具有明确定义的目的和期望是可以的。

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

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

1 个答案: