宏excel將創建新的工作表，其名稱基於列表，但如果重復則不創建

Question

我可以使用以下代碼（如下）基於選定的“名稱”列表創建包含其名稱的工作表，但是當存在重復名稱的單元格時，它將創建一個沒有名稱的工作表和通用“ sheet ##” 。 我想要重復的單元格名稱，或者已經有一個具有該名稱的表（相同的東西）而不創建新的表。

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