Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите плз написать макрос / 10 сообщений из 10, страница 1 из 1
14.04.2011, 13:46
    #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
14.04.2011, 13:52
    #37216364
zaqxsw111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите плз написать макрос
A = Val(Q), конечно
...
Рейтинг: 0 / 0
14.04.2011, 14:14
    #37216430
Shamanus
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите плз написать макрос
zaqxsw111,

а что сделать то?
...
Рейтинг: 0 / 0
14.04.2011, 14:17
    #37216437
zaqxsw111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите плз написать макрос
Shamanus, добавить новый лист, имя которого формируется из полей существующего листа
+добавить его по порядку
...
Рейтинг: 0 / 0
14.04.2011, 14:20
    #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
14.04.2011, 14:42
    #37216493
Shamanus
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите плз написать макрос
zaqxsw111,

можно сделать Add и указать ему After
или сделать Add, а потом сделать ему Move
...
Рейтинг: 0 / 0
14.04.2011, 21:27
    #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
14.04.2011, 21:28
    #37217361
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите плз написать макрос
Конечно же
Sub Макрос1()
:(
...
Рейтинг: 0 / 0
14.04.2011, 21:30
    #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
14.04.2011, 21:33
    #37217368
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите плз написать макрос
Ошибся, всё не лишнее. Лишнее только
Код: plaintext
Debug.Print SheetNames(i)
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите плз написать макрос / 10 сообщений из 10, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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