Добрый день! Прошу помощи у гуру макросов ) Помогите пожалуйста разобраться, что не так я делаю, вроде всё по аналогии сделал, подставил свои параметры, а debug упорно выдает ошибку ((( В приложении пример (спецификация) необходимо чтобы их разбивало на листы и присваивались имена этим листам в соответствии с данными, которые находятся во второй строке к примеру: "к Договору № 1П-14 от 09.01.2014". За любую помощь буду благодарен! И если вдруг еще и подскажете как сохранять все полученные листы по отдельным файлам будет просто сказка, можно даже ссылкой )))
Добрый день! Прошу помощи у гуру макросов ) Помогите пожалуйста разобраться, что не так я делаю, вроде всё по аналогии сделал, подставил свои параметры, а debug упорно выдает ошибку ((( В приложении пример (спецификация) необходимо чтобы их разбивало на листы и присваивались имена этим листам в соответствии с данными, которые находятся во второй строке к примеру: "к Договору № 1П-14 от 09.01.2014". За любую помощь буду благодарен! И если вдруг еще и подскажете как сохранять все полученные листы по отдельным файлам будет просто сказка, можно даже ссылкой )))kot2012
В макросах новичек, поэтому только поправил замеченные ошибки [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] В самом файле у Вас повторяются номера договоров, и последний расположен не в той ячейке. Т.к. название листов не может совпадать, то номера должны быть уникальными
Добрый.
В макросах новичек, поэтому только поправил замеченные ошибки [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
Сообщение отредактировал bigor - Пятница, 27.11.2020, 12:58
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
bigor, огромное спасибо за помощь!!! Всё заработало!!!! Вы гений ))) А не могли бы объяснить что именно не так было у меня? Я просто ещё больший новичок чем вы ))
bigor, огромное спасибо за помощь!!! Всё заработало!!!! Вы гений ))) А не могли бы объяснить что именно не так было у меня? Я просто ещё больший новичок чем вы ))kot2012
1. Вы проверяли по условию "к Договору", но в файле нет такой строки. Можно было конечно взять нужное количество левых символов, но я сделал по условию "Приложение". Для чего пришлось потом увеличивать Bg на 1 при копировании диапазона. 2. Поменял условия выполнения первого цикла, что бы не было подстановки 0 и отрицательных значений в номер строки.
1. Вы проверяли по условию "к Договору", но в файле нет такой строки. Можно было конечно взять нужное количество левых символов, но я сделал по условию "Приложение". Для чего пришлось потом увеличивать Bg на 1 при копировании диапазона. 2. Поменял условия выполнения первого цикла, что бы не было подстановки 0 и отрицательных значений в номер строки.bigor
bigor, не подскажете в чём может быть ошибка? На другом компьютере не хочет упорно отрабатывать ((( вроде внес необходимые изменения а всё равно выскакивает ошибка Run time error 13 Tupe mismatch, на строчке Set ws = ActiveSheet останавливается. Excel 2016
bigor, не подскажете в чём может быть ошибка? На другом компьютере не хочет упорно отрабатывать ((( вроде внес необходимые изменения а всё равно выскакивает ошибка Run time error 13 Tupe mismatch, на строчке Set ws = ActiveSheet останавливается. Excel 2016kot2012
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
RAN, да я как бы не против и не в коем разе не откажусь от любой помощи! Просто он один из первых помог да и в других вопросах тоже быстро отвечал, вот его и попросил )) а так я за любую помощь руками, лапами и всем чем угодно ))
RAN, да я как бы не против и не в коем разе не откажусь от любой помощи! Просто он один из первых помог да и в других вопросах тоже быстро отвечал, вот его и попросил )) а так я за любую помощь руками, лапами и всем чем угодно ))kot2012
Здравствуйте. В VBA для сравнения строки с шаблоном можно использовать оператор Like. [vba]
Код
Do Until (.Cells(Bg, 21).Value Like "Приложение # из #")
[/vba] Слева от Like указывается проверяемая строка, справа - шаблон, на соответствие которому нужно проверить строку.
В Вашем случае шаблон может быть, например, таким - "Приложение # из #" Соответствовать этому шаблону будут все ваши примеры "Приложение 1 из 1", "Приложение 1 из 2", "Приложение 2 из 3" ну и так далее. А вот "Приложение 10 из 9", "Приложение 1 из 13" - уже не соответствуют.
Для справки символ # (шарп или решетка) означает ОДНУ любую цифру (0-9) символ ? (вопрос) означает ОДИН любой символ, в том числе и цифру символ * (звездочка) означает ЛЮБОЕ КОЛИЧЕСТВО любых символов, в том числе и их отсутствие [набор_символов] - соответствует любому отдельному знаку из перечисленных в набор_символов [!набор_символов] - соответствует любому отдельному знаку кроме перечисленных в набор_символов
Здравствуйте. В 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
Сообщение отредактировал CaramelManiac - Четверг, 03.12.2020, 00:29
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
kot2012, Доброго Дня всем. А сам текст ошибки вас не смущает? Скриншот ошибки прилагаю ниже. У вас скорее всего где-то договор имеет дубль, одинаковое имя.
UPD: Вот в вашем предыдущем файле не наблюдается ошибка. Ищите договора с одинаковыми названиями.
kot2012, Доброго Дня всем. А сам текст ошибки вас не смущает? Скриншот ошибки прилагаю ниже. У вас скорее всего где-то договор имеет дубль, одинаковое имя.
UPD: Вот в вашем предыдущем файле не наблюдается ошибка. Ищите договора с одинаковыми названиями.MikeVol
MikeVol, точно ) вот какова вероятность что можно при рандомном наборе набрать одинаковые названия!? Рука лицо! Только я так могу лохануться )) спасибо!!!
MikeVol, точно ) вот какова вероятность что можно при рандомном наборе набрать одинаковые названия!? Рука лицо! Только я так могу лохануться )) спасибо!!!kot2012
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
