Страницы: 1
RSS
Разбить один файл excel на несколько отдельных книг, по значениям в столбце
 
Добрый день!

Подскажите пожалуйста, есть ли такой макрос, который разбивает один файл, на несколько отдельных книг по значению в столбце? К примеру, во вложении файл. По нему запускается печать. Нужно каждой типографии отправить свои стороны с макетами. То есть на выходе должно получиться столько же отдельных книг, сколько и типографий, сложенных в одну папку.
Если может кто - то помочь, напишите пожалуйста макрос. Только максимально подробно, т. к. ранее никогда с макросами не работал. И идеале в самом макросе напишите, что, за то отвечает, т. к. иногда переменные могут меняться. То есть не только по типографиям, а к примеру по менеджерам.
Нашел где - то на просторах более менее подходящий макрос, но он почему то не работает, выдает ошибку. Может его получится исправить?

Вот тот самый макрос, который не работает:
Код
Sub Разнести_по_книгам()
Const cc = 6 ' столбец по которому разделять
Const шапка = False
Set wbAct = ActiveWorkbook

Set dic = CreateObject("Scripting.Dictionary")

lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column

arr = Range("A1", Cells(lr, lc)).Value

If шапка Then fr = 2 Else fr = 1

For i = fr To UBound(arr)
   If Trim(arr(i, cc)) <> "" Then dic.Item(arr(i, cc)) = dic.Item(arr(i, 2)) & "|" & i
Next

iPath = wbAct.Path & Application.PathSeparator & "Temp" & Application.PathSeparator
If Dir(iPath, vbDirectory) = "" Then MkDir iPath

arrDic = dic.keys
Set Rng = Nothing
Application.DisplayAlerts = False
For i = 0 To UBound(arrDic)
rrs = Split(Mid(dic.Item(arrDic(i)), 2), "|")
   If шапка Then Set Rng = Rows(1)
   For Each rr In rrs
       If Not Rng Is Nothing Then Set Rng = Union(Rows(rr), Rng) Else Set Rng = Rows(rr)
   Next
   Set wb = Workbooks.Add(1)
   Set sh = wb.Sheets(1)
   Rng.Copy
   sh.[A1].PasteSpecial xlPasteColumnWidths
   sh.[A1].PasteSpecial xlPasteAll
   Set Rng = Nothing
   wb.SaveAs iPath & arrDic(i) & ".xlsx", xlOpenXMLWorkbook
   wb.Close False
Next
Application.DisplayAlerts = True
End Sub
 
Поправил ваш макрос. См. файл. Макрос запускается по Alt+F8
Изменено: New - 06.04.2023 16:51:38
 
Все работает! Спасибо большое!!!
 
Поправил код, а то немного не так работал. Используйте этот файл
 
Еще раз, большое спасибо!
 
Добрый день!

Помогите доработать выше приведенный макрос под мои задачи. В макросах не силен.
Нужно чтобы:
- шапка в файлах с итогами разбивки содержала 5 и 6 строки (возможно больше строк) (Const HeaderRow = 6 'номер строки с шапкой таблице);
- наименование вновь создаваемых файлов в папке Temp содержало не только наименование условия отбора, но и данные из ячейки H2, т.е. наименование файла не просто Ракурс, а Ракурс_авг 2022
- существенным недостатком данного макроса для моей задачи является копирование и вставка данных не как значение, а с сохранением формул.
В идеале нужно чтобы значения из ячеек, имеющих формулы с ссылкой на другие листы вставлялись как значения (без сохранения формулы), а ячейки, имеющих формулы без ссылкой на другие листы сохраняли формулы. Не в идеале чтобы копирование и вставка данных во вновь созданные книги производилось как значение (без сохранения формулы).

Заранее спасибо откликнувшимся  
 
Цитата
написал:
В идеале нужно чтобы значения из ячеек, имеющих формулы с ссылкой на другие листы вставлялись как значения (без сохранения формулы), а ячейки, имеющих формулы без ссылкой на другие листы сохраняли формулы. Не в идеале чтобы копирование и вставка данных во вновь созданные книги производилось как значение (без сохранения формулы).
Уточнение, формат выборки должен сохранять формат первоисточника, т.е., заливка, шрифт, ширина столбцов, строк, должна сохраняться (в том числе и скрытые столбцы должны оставаться скрытыми, а не разворачиваться, либо удаляться)
 
Цитата
написал:
формат выборки должен сохранять формат первоисточника, т.е., заливка, шрифт, ширина столбцов, строк, должна сохраняться (в том числе и скрытые столбцы должны оставаться скрытыми, а не разворачиваться, либо удаляться)
Если так, то проще сделать "от обратного": скопировать полностью лист, а в нём потом оставить только те строки, которые нужны для каждого файла. Тогда всё форматирование сохранится по умолчанию.
Во вложенном файле так и сделано. Кроме того, согласно просьбе:
- В конечных файлах названия сделаны из названия клиента с добавлением месяца и года.
- Все формулы, ссылающиеся на другие листы или книги, заменены на значения. Формулы, относящиеся только к данному листу, оставлены.
 
tolikt огромное спасибо, очень помогли, все работает супер.
Но есть несколько моментов (файл пример во вложении):
- по столбцу D формула ссылающаяся на другой лист осталась формулой, а не перешла в значение
- в столбцах AK, AL комбинация не сработала, формулы ссылающиеся на текущий лист перешли в значения
- в столбцах AE-AK, AR, AX-BE все сработало как нужно, формулы ссылающиеся на др.листы перешли в значения, формулы ссылающиеся на тек.лист остались формулами
- цветовая палитра шапки в формируемых файлах выборки меняется, но это совершенно не принципиально.
Если кто то будет использовать макрос в текущей редакции, обратите внимание, макрос не отработает, если столбец условие будет скрыт
Изменено: Юрий - 07.08.2022 10:43:02
 
Да, макрос удаления в формулах ссылок на другие книги работает с глюками, о чём честно написано по адресу, откуда он был скопипастен: вверху Module2.
В таком случае процедуру эту, наверное, лучше будет делать по-другому - разрыв связей с другими книгами. Нашёл такой макрос:
Код
Sub BreakLinks()
    Dim vLinks As Variant
    Dim lLink As Long
    ' Define variable as an Excel link type.
    vLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
'    If vLinks = vbNullString Then Exit Sub
'    If IsEmpty(vLinks) Then Exit Sub
    If Not IsArray(vLinks) Then Exit Sub
    ' Break all links in the active workbook.
    For lLink = LBound(vLinks) To UBound(vLinks)
        ActiveWorkbook.BreakLink Name:=vLinks(lLink), Type:=xlLinkTypeExcelLinks
    Next lLink
End Sub
Вроде как работает, в т.ч. с формулами в скрытых столбцах, но сильно не гонял.

По изменению цвета шапки в копируемых листах - не понял. Лист просто копируется полностью, т.е. вместе с форматами и т.п., и далее никаких манипуляций с оформлением не производится. Цвета никак не должны меняться.
Изменено: tolikt - 07.08.2022 11:39:44
 
tolikt огромное спасибо, это то что нужно, вставил данный макрос в основной, отрабатывает как надо. Цвета заливки именно шапки меняются во вновь созданных книгах с выборкой, пока не могу понять почему, но это совершенно не принципиально. Выкладываю окончательный вариант, может кому пригодится  
 
New,  можете подсказать, как в этот макрос добавить условие, чтобы он копировал данные со всех листов файла?  
 
New, мне поручил ответить за него
чтобы макрос копировал данные со всех листов файла нужно не условие дописать в макрос, а переписать макрос так, чтобы он копировал данные со всех листов книги
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, ))
Анна, нужно добавить код для обхода всех листов в файле, вот как пример этого

Код
Sub Test()
    Dim Sht As Worksheet   
    
    For Each Sht In ActiveWorkbook.Worksheets
        Sht.Activate

        'тут код для обработки каждого листа
        
    Next Sht
End Sub
Изменено: New - 06.04.2023 18:04:46
 
New, спасибо. Буду пробовать.  
 
Добрый день! У меня есть файл Excel с несколькими листами. Расчеты на главном листе ссылаются на остальные листы. Как можно доработать макрос, чтобы он делил файл на несколько файлов по условию на главном листе (разделить надо по отделам), причем все остальные листы остались бы неизменными в каждом поделенном файле? И еще, чтобы формулы с ссылками были на листы именно каждого поделенного файла, а не на основной?

Буду очень признательна, если в макросе пропишите комментарии, что и зачем, поскольку это частый запрос, а таблицы и файлы бывают очень разными!  
 
Ольга31,  добрый день.
Макрос должен открыть файл, выкинуть лишнее, сохранить как первый поделённый, закрыть.
Затем снова,
и снова, и снова...
 
Ольга31, приложите файл-пример, как есть сейчас и как надо, и будет вам макрос
 
Файл исходник для примера прикрепила. То есть на выходе должны получиться два файла: 1. Медиа, 2. НО.
 
Цитата
написал:
Поправил код, а то немного не так работал. Используйте этот файл
Добрый день!
Подскажите пожалуйста, а возможно скорректировать данный макрос так, чтобы он не только разбивал один файл на несколько книг, но и отправлял письма с этими файлами через Outlook? К примеру, если добавить в какой - то столбец адреса электронной почты того или иного подрядчика? Соответственно автоматические должны создаваться и тема письма и тело письма.
Пробовал сделать это через ChatGPT, но ничего не вышло. Постоянно ругается и выет ошибки
 
Артем Емельянов
Цитата
Пробовал сделать это через ChatGPT, но ничего не вышло. Постоянно ругается и выет ошибки
А знаете чтобы ChatGPT написал хороший код его надо долго уговаривать и просить " Напиши пожалуйста хороший код"  :D
Ну теперь по сути вообще то этот вопрос не относится к этой теме, и от модераторов наверняка получите выговор. А сами не пробовали здесь  в темах поискать как отправить сообщение через Outlook По моему таких тем не одна была и на сайте Щербакова по моему есть макросы. Вот если не получится это объединить тогда и создавайте новую тему.
 
Здравствуйте, уважаемые гуру экселя, я не супер продвинутый в программе, но пытаюсь и учусь.
дело в том  что я  не могу логически довести мысль в таблице  до правильной работы, если для Вас не сложно помогите пожалуйста.
дано склад
в складе приход,  участки1, 2, 3, 4, 5 с выданным материалом , и остаток.
всё дело в том  что ни как не додумаюсь с остатком, а именно:
пришло на склад 10 винтиков(допустим) участок 1 взял 3 в работу, но выполнил только 1 и у него на остатке осталось 2, а в таблице общей по складу должен остаток числиться 9, то есть 10-3+2=9 и вся эта информация на разных листах, Уважаемые подскажите как правильно реализовать всё. заранее благодарю и просьба кирпичами не  кидаться, я не очень силен.  
Страницы: 1
Наверх