Страницы: 1
RSS
Переименование ярлыков листа, изменение нумерации в ярлыках листов
 
Уважаемые гуру, имеется файл эксель в котором на каждом листе находятся данные учащихся одного класса, соответственно и сам ярлык листа имеет название класса (3_В, 5_А, 7_Г к примеру), подскажите как на первый лист добавить кнопку с макросом, который бы увеличивал цифру в названии ярлыка на единицу, т.е. из 3_В делал 4_В; из 5_А делал 6_А? Это чтобы в сентябре, когда ученики переходят в новый класс не переименовывать вручную все ярлычки.
Заранее спасибо
Файл пустышку прикрепил, если можно покажите на нем как это реализовать!
 
для упрощения, я б делал два прохода, на первом шаге изменял бы 3_Г на _4_Г. А потом по всем листам удалял бы первый _. Это для того чтоб не разбираться с порядком переименования листов.
По вопросам из тем форума, личку не читаю.
 
Цитата
edkudin написал: т.е. из 3_В делал 4_В; из 5_А делал 6_А
А из '11_А' какой номер класса нужно сделать?
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
А из '11_А'
Чем тебе 12 не нравится?  :D
Код
Sub Мяу()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Name = Replace(sh.Name, Val(sh.Name), Val(sh.Name) + 1)
    Next
End Sub
 
RAN, Андрей, 12 то ок, а вот в оригинале наверняка есть 1_А и 2_A  и так до 11. то есть надо переименовывать в обратном порядке , освобождая имена или как я писал выше сперва высвободить все .
Код
Sub RRRRR()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Name = "_" & Replace(sh.Name, Val(sh.Name), Val(sh.Name) + 1)
    Next
    For Each sh In ThisWorkbook.Worksheets
        sh.Name = Mid(sh.Name, 2)
    Next
End Sub
Изменено: БМВ - 20.04.2019 14:00:01
По вопросам из тем форума, личку не читаю.
 
Цитата
Sanja написал:
А из '11_А' какой номер класса нужно сделать?
В идеале конечно всех учеников после 11 класса собирать на отдельный лист "выпускники" так на всякий случай, чтобы оставались данные
только в реальности классов может быть много, к примеру первых классов- А, Б, В, Г, Д, Е, Ж, З, И, К  а 11 классов всего три А, Б, В
А сколько будет на следуюющий год... даже богу неизвестно...
Изменено: edkudin - 20.04.2019 16:04:06
 
Цитата
БМВ написал:
на первом шаге изменял бы 3_Г на _4_Г
я тут обдумывал... такой вариант не прокатит... можно затереть "верхний" класс
я хоть и могу ошибаться, но алгоритм вижу так:
1- все 11е классы добавляем на лист выпускники в конец списка (там если что найти данные проблем не будет)
2- начинаем переименовывать "от верха" к "низу" т.е. 10_А в 11_А; 10_Б в 11_Б и т.д. 3_Ж в 4_Ж и т.д. затирая последуюющий, уже ненужный лист новым...
а первые классы создаем по количеству ставших вторых.. и если не хватит или будут лишние то добавляем вручную.
3- но на следующий год всё должно повториться с учетом добавленных в ручном режиме листов...



.... для меня это "пока непосильная ноша"
 
Цитата
edkudin написал:
2- начинаем переименовывать "от верха" к "низу"
ну пока вы будете разыскивать этот верх среди
Цитата
edkudin написал:
А сколько будет на следуюющий год... даже богу неизвестно...
, мой вариант переименовывать закончит. Останется только добавить нужный набор единичек и что-то сделать с 12. Но это уже вопрос другой темы
По вопросам из тем форума, личку не читаю.
 
я имел ввиду а не получится так, что переименовав скажем 4_В в 5_В мы удалим данные старого класса который был ранее под названием 5_В?
 
Миш, прозевал, что чел за всю школу разом отдувается.
Код
Sub Мяу()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Name = Replace(sh.Name, Val(sh.Name), Val(sh.Name) + 31)
    Next
    For Each sh In ThisWorkbook.Worksheets
        sh.Name = Replace(sh.Name, Val(sh.Name), Val(sh.Name) - 30)
      If Val(sh.Name) = 12 Then sh.Name = Replace(sh.Name, Val(sh.Name), "Брысь")
    Next
End Sub
 
ну во первых ничего не удалится ибо это просто приведет к ошибке и еще в #2 я писал
Цитата
БМВ написал:
на первом шаге изменял бы 3_Г на _4_Г.
а в #5 это как раз и сделано.
По вопросам из тем форума, личку не читаю.
 
БМВ, RAN посмотрел ваши алгоритмы, спасибо принцип понял, один символ_ добавил, второй +30 к названию... а вот в варианте

RAN как  вместо БРЫСЬ на другой лист добавлять, так чтобы старые данные не затерлись?
 
Вот что у меня получилось, если класс после 11го то дописывается в лист Выпускники а сам лист удаляется
Код
Sub Кнопка1_Щелчок()
Application.DisplayAlerts = False
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Name = Replace(sh.Name, Val(sh.Name), Val(sh.Name) + 31)
    Next
    For Each sh In ThisWorkbook.Worksheets
      sh.Name = Replace(sh.Name, Val(sh.Name), Val(sh.Name) - 30)
      If Val(sh.Name) = 12 Then
      Sheets(sh.Name).Select
      Range("B2:D4").Select
      Selection.Copy
      Sheets("Выпускники").Select
      endLastRow = Columns("B:D").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Range(Cells(endLastRow + 1, 2), Cells(endLastRow + 1, 4)).Select
      ActiveSheet.Paste
      ThisWorkbook.Sheets(sh.Name).Delete
    End If
    Next
 Application.DisplayAlerts = True
 Sheets("Меню").Select
    Range("A1").Select
End Sub


Может кто посмотрит, всё ли нормально? Может есть возможность улучшить?
 
Код
Sub Кнопка1_Щелчок()
    Application.DisplayAlerts = False
    Dim sh As Worksheet
    Dim vp As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Name = Replace(sh.Name, Val(sh.Name), Val(sh.Name) + 31)
    Next
    For Each sh In ThisWorkbook.Worksheets
        sh.Name = Replace(sh.Name, Val(sh.Name), Val(sh.Name) - 30)
        If Val(sh.Name) = 12 Then
            If vp Is Nothing Then
                Set vp = Worksheets.Add(after:=Sheets(Sheets.Count))
                vp.Name = "Бяка"
            End If
            sh.Range("B2").CurrentRegion.Copy vp.Range("B" & Rows.Count).End(xlUp).Offset(1)
            Application.DisplayAlerts = False
            sh.Delete
            Application.DisplayAlerts = True
        End If
    Next
    Sheets("Меню").Select
    Range("A1").Select
End Sub
 
неее, ругается на vp.Name = "Бяка"
после повторного нажатия
 
Так если такой лист уже есть - правильно что ругается. Думайте что делать.
 
Цитата
edkudin написал:
алгоритм вижу так
Так в чем проблема ? Вы уже разработали алгоритм, теперь вам нужно перевести его в код.
Хорошей базой будет код "RAN" (#14), например:
Код
Option Explicit

Sub Knopka1()
    Dim sht As Object, as_sifr, i As Integer, kolist As Integer
    
    'Vypuskniki
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "Menu" And sht.Name <> "Vypuskniki" Then
            as_sifr = Split(sht.Name, "_", -1, 1)
            If IsNumeric(as_sifr(0)) Then
                If as_sifr(0) = 11 Then
                    With Sheets("Vypuskniki")
                        With .Range("B" & .Rows.Count).End(xlUp)
                            sht.Range("B2").CurrentRegion.Copy .Offset(1, 0)
                            Application.CutCopyMode = False
                        End With
                    End With
                    Application.DisplayAlerts = False
                    sht.Delete
                    Application.DisplayAlerts = True
                End If
            End If
        End If
    Next
    ' 2 do 10
    kolist = ThisWorkbook.Worksheets.Count
    For i = kolist To 1 Step -1
        With ThisWorkbook.Worksheets(i)
            If .Name <> "Menu" And .Name <> "Vypuskniki" Then
                as_sifr = Split(.Name, "_", -1, 1)
                If IsNumeric(as_sifr(0)) Then
                    If as_sifr(0) > 1 Then .Name = as_sifr(0) + 1 & "_" & as_sifr(1)
                End If
            End If
        End With
    Next
    'Novyye 1
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "Menu" And sht.Name <> "Vypuskniki" Then
            as_sifr = Split(sht.Name, "_", -1, 1)
            If IsNumeric(as_sifr(0)) Then
                If as_sifr(0) = 1 Then
                    sht.Name = "2" & "_" & as_sifr(1)
                    sht.Copy Before:=sht
                    ActiveSheet.Name = "1" & "_" & as_sifr(1)
                    ActiveSheet.Range("B2").CurrentRegion.ClearContents
                End If
            End If
        End If
    Next
    ThisWorkbook.Sheets("Menu").Select
End Sub
 
Вообще то я в 13 сообщении свой код составил и выложил, думал вдруг кто-то модифицирует чтоб уж наверняка
...но вот принцип создания новых я у Вас поштудирую...
Изменено: edkudin - 21.04.2019 17:10:27
Страницы: 1
Наверх