powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите плз написать макрос
10 сообщений из 10, страница 1 из 1
Помогите плз написать макрос
    #37216345
zaqxsw111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Нужен макрос добавления нового листа.
Лист исходный имеет имя числовое N(1,2,3 и так далее)
новый лист, должен называться N_1,N_2,N_3 и так далее, где цифра после подчеркивания должна считываться из первой колонки активной строчки - она тоже числовая, там идут числа по возрастанию от 1.
соответственно листы должны добавляться в правильном порядке. т.е. должно получиться примерно так 1_1, 1_2,1_5, 2, 2_1, 2_7 и т.п.

начал делать вот так

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Sub Макрос1()
Dim Q,W As String
Dim A,S As Integer

    Q = ActiveSheet.Name
    A = Val(A)
    A = A -  1 
    Sheets.Add

    ActiveSheet.Name = A & "_" & S
    End Sub

в строке W соответственно предполагаю информацию по ActiveCell получить
в переменную S вписать значение ячейки из 1-ого столбца активной строчки.
подскажите, как сделать.
И как добавить условие, чтобы новые листы по порядку создавались
...
Рейтинг: 0 / 0
Помогите плз написать макрос
    #37216364
zaqxsw111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
A = Val(Q), конечно
...
Рейтинг: 0 / 0
Помогите плз написать макрос
    #37216430
Фотография Shamanus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zaqxsw111,

а что сделать то?
...
Рейтинг: 0 / 0
Помогите плз написать макрос
    #37216437
zaqxsw111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shamanus, добавить новый лист, имя которого формируется из полей существующего листа
+добавить его по порядку
...
Рейтинг: 0 / 0
Помогите плз написать макрос
    #37216443
zaqxsw111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Sub Макрос1()
Dim Q, W As String
Dim A, S As Integer
A =  0 
S =  0 

    Q = ActiveSheet.Name
    A = Val(Q)
        
    W = ActiveCell
    S = Val(ActiveCell)
    
    Sheets.Add
    ActiveSheet.Name = A & "_" & S
    End Sub

примерно так, только еще не знаю как сделать чтобы в нужное место страницу вставлял..
...
Рейтинг: 0 / 0
Помогите плз написать макрос
    #37216493
Фотография Shamanus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
zaqxsw111,

можно сделать Add и указать ему After
или сделать Add, а потом сделать ему Move
...
Рейтинг: 0 / 0
Помогите плз написать макрос
    #37217359
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Сортируйте:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
Option Explicit

Sub Ģąźšīń 1 ()
Dim Q As String, W As String
Dim A As Integer, S As Integer
A =  0 
S =  0 

    Q = ActiveSheet.Name
    A = Val(Q)
        
    W = ActiveCell
    S = Val(ActiveCell)
    
    Sheets.Add
    ActiveSheet.Name = A & "_" & S
    SortSheets
    End Sub

Sub SortSheets()
Dim SheetNames() As String
Dim SheetCount As Integer
Dim i As Integer
    SheetCount = ActiveWorkbook.Sheets.Count
    ReDim SheetNames( 1  To SheetCount)
        For i =  1  To SheetCount
           SheetNames(i) = ActiveWorkbook.Sheets(i).Name
           Debug.Print SheetNames(i)
        Next i
    Call BubbleSort(SheetNames)
    For i =  1  To UBound(SheetNames)
    Sheets(SheetNames(i)).Move after:=Sheets(Sheets.Count)
    Next
End Sub


Sub BubbleSort(List() As String)
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As String
    First = LBound(List)
    Last = UBound(List)
        For i = First To Last -  1 
            For j = i +  1  To Last
                If List(i) > List(j) Then
                    Temp = List(j)
                    List(j) = List(i)
                    List(i) = Temp
                End If
            Next j
        Next i
End Sub


Вероятно неоптимально - взял, что было готовое под рукой...
...
Рейтинг: 0 / 0
Помогите плз написать макрос
    #37217361
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Конечно же
Sub Макрос1()
:(
...
Рейтинг: 0 / 0
Помогите плз написать макрос
    #37217364
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Лишнее, удалите:

Код: plaintext
1.
2.
3.
4.
       For i =  1  To SheetCount
           SheetNames(i) = ActiveWorkbook.Sheets(i).Name
           Debug.Print SheetNames(i)
        Next i
...
Рейтинг: 0 / 0
Помогите плз написать макрос
    #37217368
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Ошибся, всё не лишнее. Лишнее только
Код: plaintext
Debug.Print SheetNames(i)
...
Рейтинг: 0 / 0
10 сообщений из 10, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите плз написать макрос
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]