宏 excel 以基于列表创建名称的新工作表，但如果重复则不创建

Question

我可以使用以下代码（如下）根据选定的“名称”列表创建包含其名称的工作表，但是当有重复名称的单元格时，它将创建一个没有名称的工作表和通用的“工作表##”。我希望如果单元格名称重复或者已经有一个具有该名称的工作表（相同的东西）不要创建一个新工作表。

Sub AddSheets()
Dim cell As Excel.Range
Dim wbToAddSheetsTo As Excel.Workbook

Set wbToAddSheetsTo = ActiveWorkbook
For Each cell In Selection
With wbToAddSheetsTo
    .Sheets.Add after:=.Sheets(.Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = cell.Value
    If Err.Number = 1004 Then
      Debug.Print cell.Value & " already used as a sheet name"
    End If
    On Error GoTo 0
End With

End Sub

Answer 1

在创建工作表之前检查它是否存在：

Public Function WorkSheetExists(SheetName As String, wrkbk As Workbook) As Boolean
    Dim wrkSht As Worksheet
    On Error Resume Next
        Set wrkSht = wrkbk.Worksheets(SheetName) 'Attempt to set reference to worksheet.
        WorkSheetExists = (Err.Number = 0) 'Was an error generated - True or False?
        Set wrkSht = Nothing
    On Error GoTo 0
End Function

然后在你的代码中创建它之前检查它是否存在：

Sub AddSheets()
    Dim cell As Excel.Range
    Dim wbToAddSheetsTo As Excel.Workbook

    Set wbToAddSheetsTo = ActiveWorkbook
    For Each cell In Selection
        **If Not (WorkSheetExists(cell.Value, wbToAddSheetsTo)) Then**
            With wbToAddSheetsTo
                .Sheets.Add after:=.Sheets(.Sheets.Count)
                On Error Resume Next
                ActiveSheet.Name = cell.Value
                If Err.Number = 1004 Then
                  Debug.Print cell.Value & " already used as a sheet name"
                End If
                On Error GoTo 0
            End With
        **End If**
    Next cell

End Sub