Страницы: 1
RSS
VBA. Если при создании листа такой лист уже есть, изменить имя создаваемого
 
Уважаемые специалисты!
Помогте, пожалуйста, поправить код.
Задача: задано определенное имя листа (sSheetName), который нужно создать. Код должен проверять наличие листа с таким же именем. Если его нет, создать лист с именем sSheetName .
Если он есть, то переименовать имеющийся лист с припиской в имени "sSheetName_old" (если опять же такой есть, то "sSheetName_old2" и тд) и создать лист с именем sSheetName.

Если код находит sSheetName первый раз, то все хорошо. Он создает лист с "sSheetName_old". Однако если "sSheetName_old" уже есть, он не переименовывает "sSheetName" в "sSheetName_old2", а просто создает новые лист без изменения названий уже существующих
Код
Sub test()

Dim sSheetName As String
Dim a As Integer

sSheetName = ThisWorkbook.Sheets("Main").Cells(2, 20).Value 'T2

If sSheetName = "" Then Exit Sub
    On Error Resume Next
        
    For i2 = 1 To Worksheets.Count
        If InStr(Worksheets(i2).Name, sSheetName) > 0 Then
        Worksheets(i2).Name = sSheetName & "_old"
    End If
Next i2

If sSheetName & "_old" = "" Then Exit Sub
    On Error Resume Next
        
    For i3 = 1 To Worksheets.Count
        If InStr(Worksheets(i3).Name, sSheetName & "_old") > 0 Then
        Worksheets(i3).Name = sSheetName & "_old" & Worksheets(sSheetName & "_old").Count
    End If
Next i3

    Worksheets.Add.Name = sSheetName
    Sheets(sSheetName).Move After:=ThisWorkbook.Sheets("DealList")

End Sub
 
Мария, здравствуйте
Во-первых, уберите пробел с тире после имени  :D

Поправить-то можно, только подход такой чреват обрастанием новыми проблемами. Тут, как цитирует один известный анекдот один крутой местный медведь-формулист, "надо определиться - вам либо шашечки, либо ехать"
Предлагаю вам рассмотреть 3 варианта работы с новыми листами
Ещё не было ни одного случая, когда бы мне понадобилось что-то другое, кроме описанного, а я делаю на VBA проекты самой разной сложности и уже несколько лет  ;)
Изменено: Jack Famous - 11.02.2021 09:27:16
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Да я бы так и сделала, удалила лист и не заморачивалась, только вот нужно сохранение "истории".
А как можно сделать, чтобы если есть sSheetName_old, он его удалил, а sSheetName переименовал в sSheetName_old ?
 
Как то так
Код
Sub test()

    Dim sSheetName As String
    Dim a As Integer
    a = 1
    sSheetName = ThisWorkbook.Sheets("Main").Cells(2, 20).Value    'T2
    If sSheetName = "" Then Exit Sub
    On Error Resume Next
    Worksheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = sSheetName
    If Err Then
        Err.Clear
        ThisWorkbook.Sheets(sSheetName).Name = sSheetName & "_old" & a
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = sSheetName
        Do While Err
            Err.Clear
            ThisWorkbook.Sheets(sSheetName).Name = sSheetName & "_old" & a + 1
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = sSheetName
            If Err Then
                a = a + 1
            End If
            DoEvents
        Loop
    End If
End Sub
 
Ещё вариант:
Код
    For i2 = 1 To Worksheets.Count
        If InStr(Worksheets(i2).Name, sSheetName) > 0 Then est = True
        If InStr(Worksheets(i2).Name, sSheetName & "_old") > 0 Then
            num = Val(Replace(Worksheets(i2).Name, sSheetName & "_old", ""))
            If Max < num Then Max = num
        End If
    Next i2
    
    If est Then
        Worksheets(sSheetName).Name = sSheetName & "_old" & Max + 1
        Worksheets.Add.Name = sSheetName
    Else
        Worksheets.Add.Name = sSheetName
    End If
 
Спасибо ОГРОМНОЕ!!!! Вы мои спасители! Все работает отлично!
Страницы: 1
Наверх