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

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

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

谢谢

Answer 1

您可能喜欢使用 function，如下所示。 你给它一个工作表名称，它会返回一个同名的工作表 object，要么是已经存在的，要么是刚刚制作的。

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 过程中调用 function。

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

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