Excel VBA 检查工作表是否已存在

Question

我在 Excel VBA 中有一些代码，它的作用是每当用户打开特定工作簿时，它会从最后一张工作表中复制内容，然后将这个新工作表放在最后，然后给出一个新工作表通过输入日期格式为工作表命名。问题是，如果由于某种原因您需要在同一天再次打开此工作簿，则会出现错误，因为工作表的名称已被占用。

我正在尝试找到一个解决方案，如果名称已经存在，则不要添加新工作表。可能我的代码的某些部分是正确的，但我猜代码行的顺序可能是导致它出错的原因。

Sub Auto()
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
For i = 1 To Sheets.Count
    If Sheets(i).Name = UCase(Format(Now, "DDMMM")) Then
    exists = True
    End If

Next i
If Not exists Then
    Sheets(Sheets.Count).Name = UCase(Format(Now, "DDMMM"))
End If

Range("A3:P3").Select
ActiveCell.FormulaR1C1 = Format(Now, "medium date")

End Sub

我刚刚添加了循环条件，但此代码有两处错误。 if 将继续查找工作簿中的每张纸，因此如果您有 200 张纸，则可能需要一些时间才能退出循环。另一个是，每当您添加一个作为另一个副本的工作表时，Excel 都会将相应副本（Sheet (2)）添加到工作表的名称中，因此循环不会执行任何操作，因为它永远不会找到相同的名称。

因此，如果您有更好的方法来检查工作表名称是否已存在，我将很高兴学习。

谢谢

Answer 1

您可能喜欢使用以下功能。你给它一个工作表名称，它会返回一个同名的工作表对象，要么是已经存在的，要么是刚刚创建的。

Function GetSheet(SheetName As String) As Worksheet

    Dim Fun         As Worksheet            ' Function return object
    
    On Error Resume Next
    Set Fun = Worksheets(SheetName)
    ' if the sheet doesn't exist an error will occur here
    If Err Then
        Set Fun = Worksheets.Add(After:=Sheets(Sheets.Count))
        Fun.Name = SheetName
    End If
    Set GetSheet = Fun
End Function

您可以使用如下所示的语法从您的 Main 过程中调用该函数。

Sub Main()
    Dim Ws          As Worksheet
    Dim SheetName   As String
    
    ' Now() includes the time
    SheetName = UCase(Format(Date, "ddmmm"))
    Set Ws = GetSheet(SheetName)
    
    With Ws
        Debug.Print .Name
        .Cells(3, "A").Value = Format(Date, "medium date")
        .Range("A3:P3").Select
    End With
End Sub

当然，当此代码集成到您的项目中时，该功能不太可能位于最前面。它将位于底部，位于 main 下方，或者，如果您的项目中有很多功能，则位于专门用于管理功能的单独模块中。