工作表名称已存在，如何处理错误并删除 Excel 中的默认工作表？

Question

使用 sheet1 中的名称创建工作表效果很好。但是，如果我再次错误地运行代码，则会出现运行时 1004 错误，因为新创建的工作表名称已经存在。这很好，但是如何处理此错误并防止 Excel 创建一个具有随机名称的默认工作表？

我希望 Excel 到 MsgBox 我有一个重复，然后它应该什么都不做。我知道有类似的线程，但他们没有回答我的问题。谢谢。

Private Sub CreateSheet()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             Worksheets("Sheet1"))

    Application.DisplayAlerts = False

    ws.Name = Sheets("Sheet1").Range("N1")

    On Error Resume Next

    If (Worksheets("ws.Name").Name <> "") Then

    MsgBox ("name already exists, please delete")

    Else

    ws.Visible = xlSheetVisible

    ThisWorkbook.Sheets("Sheet1").Range("A:AB").Copy
    ThisWorkbook.Sheets(ws.Name).Range("A1").PasteSpecial Paste:=xlPasteValues

    End If

End Sub

Answer 1

在运行工作表创建代码之前，您可以创建一个自定义函数并在代码中对其进行测试，例如...

Public Function SheetExists(WkBkName As String, ShtName As String) As Boolean
    Dim sht As Worksheet
    On Error Resume Next
    Set sht = Application.Workbooks(WkBkName).Worksheets(ShtName)
    On Error GoTo 0
    If sht Is Nothing Then
        SheetExists = False
    Else
        SheetExists = True
    End If
End Function

然后您可以在如下代码中使用此 UDF...

Sub Test()
    If SheetExists(ThisWorkbook.Name, "Sheet2") Then
        MsgBox "Sheet Exists!"
    Else
        MsgBox "Sheet Doesn't Exist!"
    End If
End Sub

Answer 2

检查工作表是否存在的另一种方法是循环，有些人更喜欢循环而不是On Error ...

 Public Function sheetExists(SheetName As String, Optional wrkBook As Workbook) As Boolean

    If wrkBook Is Nothing Then
        Set wrkBook = ActiveWorkbook 'or ThisWorkbook - whichever appropriate
    End If

    On Error GoTo EH

    sheetExists = False  ' Not really neccessary as this is the default

    Dim sht As Object

    For Each sht In wrkBook.Sheets
        If Ucase(sht.Name) = UCase(SheetName) Then
            sheetExists = True
            Exit For
        End If
    Next sht

    Exit Function

EH:
    sheetExists = False
End Function

然后你可以这样重写你的子

Private Sub CreateSheet()
    Dim ws As Worksheet

    'Application.DisplayAlerts = False

    Dim newName As String
    newName = Sheets("Sheet1").Range("N1")

    If sheetExists(newName, ThisWorkbook) Then
        MsgBox ("name already exists, please delete")
    Else
        Set ws = ThisWorkbook.Sheets.Add(After:= _
            Worksheets("Sheet1"))

        ws.Visible = xlSheetVisible
        ws.Name = newName

        ThisWorkbook.Sheets("Sheet1").Range("A:AB").Copy
        ws.Range("A1").PasteSpecial Paste:=xlPasteValues

    End If

End Sub

Answer 3

这应该可行。为什么不只遍历现有工作表并比较它们的名称？如果发现重复，则不要创建新工作表。

Private Sub CreateSheet()

    Dim ws As Worksheet

    Dim sheet_counter As Integer
    Dim check_duplicates As Boolean

    check_duplicates = False
    Application.DisplayAlerts = False

    WS_Count = ActiveWorkbook.Worksheets.Count


    For sheet_counter = 1 To WS_Count
        If ActiveWorkbook.Worksheets(sheet_counter).Name = Sheets("Sheet1").Range("N1") Then:
            check_duplicates = True
            MsgBox ("Name already exists, Worksheet not created")

    If Not check_duplicates Then:
        Set ws = ThisWorkbook.Sheets.Add(After:=Worksheets("Sheet1"))


    If Not Sheets("Sheet1").Range("N1") = "" Then
        ws.Name = Sheets("Sheet1").Range("N1")


    On Error Resume Next


        ws.Visible = xlSheetVisible

        ThisWorkbook.Sheets("Sheet1").Range("A:AB").Copy
        ThisWorkbook.Sheets(ws.Name).Range("A1").PasteSpecial Paste:=xlPasteValues

    End If

End Sub

Answer 4

我个人不是On Error 声明的忠实拥护者，尽管它在这里可能是合法的使用。但是，这是另一个想法，请根据您的需要进行调整：

Dim nom As String: nom = "Sheet1"

If VarType(Evaluate(Replace("?!A1", "?", nom))) <> vbError Then
    'Sheet exists
Else
    'Sheet does not exists
End If

_{注意：如果评估的单元格本身没有错误，这将起作用。所以也许选择一个你知道不会有任何公式的单元格。}