Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Как разбить данные одного листа на несколько листов - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как разбить данные одного листа на несколько листов (Формулы/Formulas)
Как разбить данные одного листа на несколько листов
kot2012 Дата: Пятница, 27.11.2020, 11:38 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
Добрый день!
Прошу помощи у гуру макросов ) Помогите пожалуйста разобраться, что не так я делаю, вроде всё по аналогии сделал, подставил свои параметры, а debug упорно выдает ошибку ((( В приложении пример (спецификация) необходимо чтобы их разбивало на листы и присваивались имена этим листам в соответствии с данными, которые находятся во второй строке к примеру: "к Договору № 1П-14 от 09.01.2014". За любую помощь буду благодарен! И если вдруг еще и подскажете как сохранять все полученные листы по отдельным файлам будет просто сказка, можно даже ссылкой )))
К сообщению приложен файл: 4271769.rar (43.9 Kb)
 
Ответить
СообщениеДобрый день!
Прошу помощи у гуру макросов ) Помогите пожалуйста разобраться, что не так я делаю, вроде всё по аналогии сделал, подставил свои параметры, а debug упорно выдает ошибку ((( В приложении пример (спецификация) необходимо чтобы их разбивало на листы и присваивались имена этим листам в соответствии с данными, которые находятся во второй строке к примеру: "к Договору № 1П-14 от 09.01.2014". За любую помощь буду благодарен! И если вдруг еще и подскажете как сохранять все полученные листы по отдельным файлам будет просто сказка, можно даже ссылкой )))

Автор - kot2012
Дата добавления - 27.11.2020 в 11:38
bigor Дата: Пятница, 27.11.2020, 12:57 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1073
Репутация: 204 ±
Замечаний: 0% ±

нет
Добрый.

В макросах новичек, поэтому только поправил замеченные ошибки
[vba]
Код
Sub a()
Dim Bg As Long, En As Long
   Dim ws As Worksheet
   
   Set ws = ActiveSheet
   With ws
      En = .Cells(Rows.Count, 1).End(xlUp).Row
      Do Until En < 2
         Bg = En
         Do Until (.Cells(Bg, 21).Value = "Приложение")
            Bg = Bg - 1
                      
         Loop
         Sheets.Add after:=Worksheets(Sheets.Count)
         ActiveSheet.Name = Left(.Cells(Bg + 1, 21).Value, 31)
         .Range(.Rows(Bg), .Rows(En)).Copy Destination:=Rows(1)
         En = Bg - 1
      Loop
   End With
End Sub
[/vba]
В самом файле у Вас повторяются номера договоров, и последний расположен не в той ячейке. Т.к. название листов не может совпадать, то номера должны быть уникальными


Сообщение отредактировал bigor - Пятница, 27.11.2020, 12:58
 
Ответить
СообщениеДобрый.

В макросах новичек, поэтому только поправил замеченные ошибки
[vba]
Код
Sub a()
Dim Bg As Long, En As Long
   Dim ws As Worksheet
   
   Set ws = ActiveSheet
   With ws
      En = .Cells(Rows.Count, 1).End(xlUp).Row
      Do Until En < 2
         Bg = En
         Do Until (.Cells(Bg, 21).Value = "Приложение")
            Bg = Bg - 1
                      
         Loop
         Sheets.Add after:=Worksheets(Sheets.Count)
         ActiveSheet.Name = Left(.Cells(Bg + 1, 21).Value, 31)
         .Range(.Rows(Bg), .Rows(En)).Copy Destination:=Rows(1)
         En = Bg - 1
      Loop
   End With
End Sub
[/vba]
В самом файле у Вас повторяются номера договоров, и последний расположен не в той ячейке. Т.к. название листов не может совпадать, то номера должны быть уникальными

Автор - bigor
Дата добавления - 27.11.2020 в 12:57
kot2012 Дата: Пятница, 27.11.2020, 13:09 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
bigor, в смысле повторяются? Они же меняются: к Договору № 1П-16 от 09.01.2014, к Договору № 1П-17 от 09.01.2014, к Договору № 1П-18 от 09.01.2014, или нужно чтобы полностью было уникальным имя?
 
Ответить
Сообщениеbigor, в смысле повторяются? Они же меняются: к Договору № 1П-16 от 09.01.2014, к Договору № 1П-17 от 09.01.2014, к Договору № 1П-18 от 09.01.2014, или нужно чтобы полностью было уникальным имя?

Автор - kot2012
Дата добавления - 27.11.2020 в 13:09
kot2012 Дата: Пятница, 27.11.2020, 13:16 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
bigor, огромное спасибо за помощь!!! Всё заработало!!!! Вы гений ))) А не могли бы объяснить что именно не так было у меня? Я просто ещё больший новичок чем вы ))
 
Ответить
Сообщениеbigor, огромное спасибо за помощь!!! Всё заработало!!!! Вы гений ))) А не могли бы объяснить что именно не так было у меня? Я просто ещё больший новичок чем вы ))

Автор - kot2012
Дата добавления - 27.11.2020 в 13:16
bigor Дата: Пятница, 27.11.2020, 14:05 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 1073
Репутация: 204 ±
Замечаний: 0% ±

нет
что именно не так было у меня?

1. Вы проверяли по условию "к Договору", но в файле нет такой строки. Можно было конечно взять нужное количество левых символов, но я сделал по условию "Приложение". Для чего пришлось потом увеличивать Bg на 1 при копировании диапазона.
2. Поменял условия выполнения первого цикла, что бы не было подстановки 0 и отрицательных значений в номер строки.
 
Ответить
Сообщение
что именно не так было у меня?

1. Вы проверяли по условию "к Договору", но в файле нет такой строки. Можно было конечно взять нужное количество левых символов, но я сделал по условию "Приложение". Для чего пришлось потом увеличивать Bg на 1 при копировании диапазона.
2. Поменял условия выполнения первого цикла, что бы не было подстановки 0 и отрицательных значений в номер строки.

Автор - bigor
Дата добавления - 27.11.2020 в 14:05
kot2012 Дата: Понедельник, 30.11.2020, 13:48 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
bigor, не подскажете в чём может быть ошибка? На другом компьютере не хочет упорно отрабатывать ((( вроде внес необходимые изменения а всё равно выскакивает ошибка Run time error 13 Tupe mismatch, на строчке Set ws = ActiveSheet останавливается. Excel 2016
К сообщению приложен файл: 4856328.jpg (35.5 Kb)
 
Ответить
Сообщениеbigor, не подскажете в чём может быть ошибка? На другом компьютере не хочет упорно отрабатывать ((( вроде внес необходимые изменения а всё равно выскакивает ошибка Run time error 13 Tupe mismatch, на строчке Set ws = ActiveSheet останавливается. Excel 2016

Автор - kot2012
Дата добавления - 30.11.2020 в 13:48
kot2012 Дата: Понедельник, 30.11.2020, 13:55 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
Не тот файл прикрепил )
К сообщению приложен файл: 2598730.xlsm (24.9 Kb)
 
Ответить
СообщениеНе тот файл прикрепил )

Автор - kot2012
Дата добавления - 30.11.2020 в 13:55
RAN Дата: Понедельник, 30.11.2020, 13:59 | Сообщение № 8
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Dim ws as WorkSheetS


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеDim ws as WorkSheetS

Автор - RAN
Дата добавления - 30.11.2020 в 13:59
kot2012 Дата: Понедельник, 30.11.2020, 14:22 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
RAN, Поправил!!!! Спасибо )))
 
Ответить
СообщениеRAN, Поправил!!!! Спасибо )))

Автор - kot2012
Дата добавления - 30.11.2020 в 14:22
kot2012 Дата: Среда, 02.12.2020, 18:30 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
bigor, обращаюсь снова к вам, благодарю еще раз вас за помощь, но пришла бяда откуда не ждали и прошу еще раз помочь! Не подскажете как лучше сделать, если в ячейки (21) [vba]
Код
Do Until (.Cells(Bg, 21).Value = "Приложение")
[/vba] "Приложение" будет меняться к примеру на: "Приложение 1 из 1", "Приложение 1 из 2", "Приложение 2 из 3" ну и так далее. Есть ли возможность сделать условие типа: "Приложение * из *", где * = 1 2 3 4 5 6 7 8 9 10 11 12..56.. и т.д. Т.е. * может принимать любое числовое значение, но слово "Приложение" всегда неизменно.
 
Ответить
Сообщениеbigor, обращаюсь снова к вам, благодарю еще раз вас за помощь, но пришла бяда откуда не ждали и прошу еще раз помочь! Не подскажете как лучше сделать, если в ячейки (21) [vba]
Код
Do Until (.Cells(Bg, 21).Value = "Приложение")
[/vba] "Приложение" будет меняться к примеру на: "Приложение 1 из 1", "Приложение 1 из 2", "Приложение 2 из 3" ну и так далее. Есть ли возможность сделать условие типа: "Приложение * из *", где * = 1 2 3 4 5 6 7 8 9 10 11 12..56.. и т.д. Т.е. * может принимать любое числовое значение, но слово "Приложение" всегда неизменно.

Автор - kot2012
Дата добавления - 02.12.2020 в 18:30
RAN Дата: Среда, 02.12.2020, 18:50 | Сообщение № 11
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Я бы, конечно, мог подсказать, но, поскольку я не bigor, то умываю лапы.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеЯ бы, конечно, мог подсказать, но, поскольку я не bigor, то умываю лапы.

Автор - RAN
Дата добавления - 02.12.2020 в 18:50
kot2012 Дата: Среда, 02.12.2020, 21:45 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
RAN, да я как бы не против и не в коем разе не откажусь от любой помощи! Просто он один из первых помог да и в других вопросах тоже быстро отвечал, вот его и попросил )) а так я за любую помощь руками, лапами и всем чем угодно ))
 
Ответить
СообщениеRAN, да я как бы не против и не в коем разе не откажусь от любой помощи! Просто он один из первых помог да и в других вопросах тоже быстро отвечал, вот его и попросил )) а так я за любую помощь руками, лапами и всем чем угодно ))

Автор - kot2012
Дата добавления - 02.12.2020 в 21:45
bigor Дата: Среда, 02.12.2020, 23:32 | Сообщение № 13
Группа: Проверенные
Ранг: Старожил
Сообщений: 1073
Репутация: 204 ±
Замечаний: 0% ±

нет
Я не могу в своем приложении работать с vba, поэтому практически не смотрю эту ветку форума. Решение вопроса уже есть в макросе в этой строке [vba]
Код
ActiveSheet.Name = Left(.Cells(Bg + 1, 21).Value, 31)
[/vba], Вам нужно брать не все содержимое ячейки, а только 10 левых символов:
[vba]
Код
Do Until  (Left(.Cells(Bg, 21).Value, 10) = "Приложение")
[/vba]
 
Ответить
СообщениеЯ не могу в своем приложении работать с vba, поэтому практически не смотрю эту ветку форума. Решение вопроса уже есть в макросе в этой строке [vba]
Код
ActiveSheet.Name = Left(.Cells(Bg + 1, 21).Value, 31)
[/vba], Вам нужно брать не все содержимое ячейки, а только 10 левых символов:
[vba]
Код
Do Until  (Left(.Cells(Bg, 21).Value, 10) = "Приложение")
[/vba]

Автор - bigor
Дата добавления - 02.12.2020 в 23:32
CaramelManiac Дата: Четверг, 03.12.2020, 00:10 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 64
Репутация: 22 ±
Замечаний: 0% ±

MS Excel 2003-2019
Здравствуйте.
В VBA для сравнения строки с шаблоном можно использовать оператор Like.
[vba]
Код
Do Until (.Cells(Bg, 21).Value Like "Приложение # из #")
[/vba]
Слева от Like указывается проверяемая строка, справа - шаблон, на соответствие которому нужно проверить строку.

В Вашем случае шаблон может быть, например, таким - "Приложение # из #"
Соответствовать этому шаблону будут все ваши примеры "Приложение 1 из 1", "Приложение 1 из 2", "Приложение 2 из 3" ну и так далее.
А вот "Приложение 10 из 9", "Приложение 1 из 13" - уже не соответствуют.

Для справки
символ # (шарп или решетка) означает ОДНУ любую цифру (0-9)
символ ? (вопрос) означает ОДИН любой символ, в том числе и цифру
символ * (звездочка) означает ЛЮБОЕ КОЛИЧЕСТВО любых символов, в том числе и их отсутствие
[набор_символов] - соответствует любому отдельному знаку из перечисленных в набор_символов
[!набор_символов] - соответствует любому отдельному знаку кроме перечисленных в набор_символов


Сообщение отредактировал CaramelManiac - Четверг, 03.12.2020, 00:29
 
Ответить
СообщениеЗдравствуйте.
В VBA для сравнения строки с шаблоном можно использовать оператор Like.
[vba]
Код
Do Until (.Cells(Bg, 21).Value Like "Приложение # из #")
[/vba]
Слева от Like указывается проверяемая строка, справа - шаблон, на соответствие которому нужно проверить строку.

В Вашем случае шаблон может быть, например, таким - "Приложение # из #"
Соответствовать этому шаблону будут все ваши примеры "Приложение 1 из 1", "Приложение 1 из 2", "Приложение 2 из 3" ну и так далее.
А вот "Приложение 10 из 9", "Приложение 1 из 13" - уже не соответствуют.

Для справки
символ # (шарп или решетка) означает ОДНУ любую цифру (0-9)
символ ? (вопрос) означает ОДИН любой символ, в том числе и цифру
символ * (звездочка) означает ЛЮБОЕ КОЛИЧЕСТВО любых символов, в том числе и их отсутствие
[набор_символов] - соответствует любому отдельному знаку из перечисленных в набор_символов
[!набор_символов] - соответствует любому отдельному знаку кроме перечисленных в набор_символов

Автор - CaramelManiac
Дата добавления - 03.12.2020 в 00:10
kot2012 Дата: Четверг, 03.12.2020, 11:14 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
CaramelManiac, спасибо за совет! А можно ли в этом операторе как то применить значение "если"? Я просто не до конца понял задачу ( оказывается дело в том что в спецификации может быть несколько листов т.е. "Приложение 1 из 3" "Приложение 2 из 3" "Приложение 3 из 3" - это одна спецификация, и соответственно нужно чтобы макрос как-то это понимал при сравнении, т.е. дойдя до "3 из 3" понимал что это один лист и начинал проверку заново. И еще может подскажете почему при выполнении этого кода [vba]
Код
Sub a()
Dim Bg As Long, En As Long
Dim ws As Worksheet

Set ws = ActiveSheet
With ws
    En = .Cells(Rows.Count, 1).End(xlUp).Row
    Do Until En < 2
        Bg = En
        Do Until (.Cells(Bg, 21).Value = "Приложение")
            Bg = Bg - 1
                    
        Loop
        Sheets.Add after:=Worksheets(Sheets.Count)
        ActiveSheet.Name = Left(.Cells(Bg + 1, 21).Value, 31)
        .Range(.Rows(Bg), .Rows(En)).Copy Destination:=Rows(1)
        En = Bg - 1
    Loop
End With
End Sub
[/vba]
Он отрабатывает только по 11 листов, дальше выскакивает ошибка что файл с таким именем уже существует? Хотя имена у спецификаций все разные и повторяющихся нет. И если нажать end и еще раз его запустить то он так же создат 11 листов с того места где он остановился. В связи с чем может быть вызвано такое поведение?
 
Ответить
СообщениеCaramelManiac, спасибо за совет! А можно ли в этом операторе как то применить значение "если"? Я просто не до конца понял задачу ( оказывается дело в том что в спецификации может быть несколько листов т.е. "Приложение 1 из 3" "Приложение 2 из 3" "Приложение 3 из 3" - это одна спецификация, и соответственно нужно чтобы макрос как-то это понимал при сравнении, т.е. дойдя до "3 из 3" понимал что это один лист и начинал проверку заново. И еще может подскажете почему при выполнении этого кода [vba]
Код
Sub a()
Dim Bg As Long, En As Long
Dim ws As Worksheet

Set ws = ActiveSheet
With ws
    En = .Cells(Rows.Count, 1).End(xlUp).Row
    Do Until En < 2
        Bg = En
        Do Until (.Cells(Bg, 21).Value = "Приложение")
            Bg = Bg - 1
                    
        Loop
        Sheets.Add after:=Worksheets(Sheets.Count)
        ActiveSheet.Name = Left(.Cells(Bg + 1, 21).Value, 31)
        .Range(.Rows(Bg), .Rows(En)).Copy Destination:=Rows(1)
        En = Bg - 1
    Loop
End With
End Sub
[/vba]
Он отрабатывает только по 11 листов, дальше выскакивает ошибка что файл с таким именем уже существует? Хотя имена у спецификаций все разные и повторяющихся нет. И если нажать end и еще раз его запустить то он так же создат 11 листов с того места где он остановился. В связи с чем может быть вызвано такое поведение?

Автор - kot2012
Дата добавления - 03.12.2020 в 11:14
bigor Дата: Четверг, 03.12.2020, 11:49 | Сообщение № 16
Группа: Проверенные
Ранг: Старожил
Сообщений: 1073
Репутация: 204 ±
Замечаний: 0% ±

нет
Он отрабатывает только по 11 листов

я думаю без файла вряд ли кто поможет.
 
Ответить
Сообщение
Он отрабатывает только по 11 листов

я думаю без файла вряд ли кто поможет.

Автор - bigor
Дата добавления - 03.12.2020 в 11:49
kot2012 Дата: Четверг, 03.12.2020, 12:48 | Сообщение № 17
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
Вот пример )) debug выдаёт на строке [vba]
Код
ActiveSheet.Name = Replace_symbols(Left(.Cells(Bg + 1, 1).Value, 31))
[/vba]
К сообщению приложен файл: 3207619.xlsm (77.9 Kb)


Сообщение отредактировал kot2012 - Четверг, 03.12.2020, 12:55
 
Ответить
СообщениеВот пример )) debug выдаёт на строке [vba]
Код
ActiveSheet.Name = Replace_symbols(Left(.Cells(Bg + 1, 1).Value, 31))
[/vba]

Автор - kot2012
Дата добавления - 03.12.2020 в 12:48
MikeVol Дата: Четверг, 03.12.2020, 13:43 | Сообщение № 18
Группа: Проверенные
Ранг: Обитатель
Сообщений: 299
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
kot2012, Доброго Дня всем. А сам текст ошибки вас не смущает? Скриншот ошибки прилагаю ниже. У вас скорее всего где-то договор имеет дубль, одинаковое имя.

UPD: Вот в вашем предыдущем файле не наблюдается ошибка. Ищите договора с одинаковыми названиями.
К сообщению приложен файл: 7524002.png (10.4 Kb) · 03.12.20.xlsm (24.3 Kb)


Ученик.

Сообщение отредактировал MikeVol - Четверг, 03.12.2020, 13:50
 
Ответить
Сообщениеkot2012, Доброго Дня всем. А сам текст ошибки вас не смущает? Скриншот ошибки прилагаю ниже. У вас скорее всего где-то договор имеет дубль, одинаковое имя.

UPD: Вот в вашем предыдущем файле не наблюдается ошибка. Ищите договора с одинаковыми названиями.

Автор - MikeVol
Дата добавления - 03.12.2020 в 13:43
kot2012 Дата: Четверг, 03.12.2020, 14:04 | Сообщение № 19
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Excel 2019
MikeVol, точно ) вот какова вероятность что можно при рандомном наборе набрать одинаковые названия!? Рука лицо! Только я так могу лохануться )) спасибо!!!
 
Ответить
СообщениеMikeVol, точно ) вот какова вероятность что можно при рандомном наборе набрать одинаковые названия!? Рука лицо! Только я так могу лохануться )) спасибо!!!

Автор - kot2012
Дата добавления - 03.12.2020 в 14:04
MikeVol Дата: Четверг, 03.12.2020, 15:06 | Сообщение № 20
Группа: Проверенные
Ранг: Обитатель
Сообщений: 299
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
kot2012, Не мне спасибо а bigor и RAN Им спасибо скажите. А я всего лишь внимание обратил на саму ошибку которая проявила себя.


Ученик.
 
Ответить
Сообщениеkot2012, Не мне спасибо а bigor и RAN Им спасибо скажите. А я всего лишь внимание обратил на саму ошибку которая проявила себя.

Автор - MikeVol
Дата добавления - 03.12.2020 в 15:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как разбить данные одного листа на несколько листов (Формулы/Formulas)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!