Как создать лист, если он еще не существует?

Question

Я использую следующий код, чтобы проверить в книге, существуют ли sheet1 и sheet2 или нет.Если они не существуют, то они должны быть созданы.В противном случае ничего не должно произойти.

Моя проблема в том, что макрос работает только для первой итерации, когда ни одна из рабочих таблиц не существует.Как только рабочие листы созданы, я получаю ошибку.Что-то вроде «Имя уже существует. Выберите другое…».Я не хочу, чтобы что-то случилось, если sheet1 и sheet2 уже существуют.

Sub Worksheet()

    Dim x As Integer, blnFound1 As Boolean, blnFound2 As Boolean
    blnFound1 = False
    blnFound2 = False

    With ThisWorkbook

        For x = 1 To .Sheets.Count

            If .Sheets(x).Name = "Sheet1" Then
                blnFound1 = True
                Exit For
            End If

            If .Sheets(x).Name = "Sheet2" Then
                blnFound2 = True
                Exit For
            End If

        Next x

        If blnFound1 = False Then
            .Sheets.Add
            With ActiveSheet
                .Name = "Sheet1"
            End With
        End If

        If blnFound2 = False Then
            .Sheets.Add
            With ActiveSheet
                .Name = "Sheet2"
            End With
        End If

    End With

End Sub

Answer 1

Я использую разные макросы для каждого проекта, поэтому вы можете использовать его в любое время:

Sub TestSheet(SheetName As String)

    Dim Exists As Boolean

    With ThisWorkbook
        On Error Resume Next
        Exists = (.Worksheets(SheetName).Name <> "")
        On Error GoTo 0
        If Not Exists Then
            .Sheets.Add After:=.Sheets(.Sheets.Count)
            .Sheets(.Sheets.Count).Name = SheetName
        End If
    End With

End Sub

Вот как вы тестируете:

Sub Test()

    TestSheet "Sheet1"
    TestSheet "Sheet2"

End Sub

Answer 2

Что если вы хотите использовать новый рабочий лист, только если он не существует?

В этом сценарии я бы использовал Try-Parse Pattern .

Для этого создайте функцию, которая принимает имя листа и параметр ByRef, который может возвращать вновь созданный объект листа.

Public Function TryCreateWorksheet(ByVal SheetName As String, Optional ByRef outWorksheet As Worksheet, Optional ByRef Source As Workbook) As Boolean

    'If workbook not passed in then set it to the activeworkbook.
    If Source Is Nothing Then
        Set Source = ActiveWorkbook
    End If

    If Not WorksheetExists(SheetName, Source) Then

        'Return true, then set outWorksheet to created worksheet and rename it.
        TryCreateWorksheet = True
        Set outWorksheet = Source.Worksheets.Add(After:=Source.Worksheets(Source.Worksheets.Count))
        outWorksheet.Name = SheetName

    End If

End Function

Вот функция для проверки, существует ли рабочая таблица. Хорошо, если вы явно укажете, в каком Workbook вы хотите выполнить проверку, чтобы не было ошибок.

Public Function WorksheetExists(ByVal SheetName As String, ByRef Source As Workbook) As Boolean
    On Error Resume Next
    WorksheetExists = (Source.Worksheets(SheetName).Name <> "")
    On Error GoTo 0
End Function

---

Как это использовать?

Если рабочий лист создан, то функция возвращает true, и вы можете смело знать, что у вас есть ссылка на новый рабочий лист.

Вы можете использовать это в операторе if, чтобы увидеть, возвращает ли оно значение true. Если это так, теперь вы можете использовать свой объект листа. Смотрите ниже:

Private Sub SomeProcedure()

    Dim CreatedWs As Worksheet
    If TryCreateWorksheet("Sheet3", CreatedWs, ActiveWorkbook) = False Then
        MsgBox "Sheet already exists", vbInformation
        Exit Sub
    End If

    'Do Something with your created Ws
    Debug.Print CreatedWs.Name

End Sub

---

Что делать, если вам нужно уникальное имя при наличии листа?

В этом случае вы можете добавить уникальный индекс в конец имен листов.

Например, если у вас есть Sheet1, следующее уникальное имя будет Sheet1 (2) и т. Д.

Public Function UniqueSheetName(ByVal Name As String, ByRef Source As Workbook) As String

    'Used to create a new unique name
    Dim NewName As String
    NewName = Name

    'Used to increment the name index. ie: Sheet1(1)
    Dim Index As Integer
    Index = 1

NameLoop:

    'If exists then change name to include increment (n)
    If WorksheetExists(NewName, Source) Then
        Index = Index + 1
        NewName = Name & " (" & Index & ")"
        GoTo NameLoop
    End If

    UniqueSheetName = NewName

End Function