У меня возникла следующая потребность - в таблице есть один столбец, в которой задана группа записи. То есть на некоторое множество записей задана определённая группа. Возникла идея сохранить в каждый отдельный файл с именем группы только те записи, которые находятся в данной группе. Другими словами, из одного большого файла нужно сделать множество мелких, в которых находятся данные только данной группы. Была попытка сохранения файлов через фильтр, то есть вручную выбирались записи, но, очевидно, что этот вариант очень плох.
Я понимаю, как обеспечить сохранение отдельных файлов, но вот момент с выбором только необходимых записей, которые удовлетворяют данной группы и не имеют пустых строчек - другое дело.
Добрый день.
У меня возникла следующая потребность - в таблице есть один столбец, в которой задана группа записи. То есть на некоторое множество записей задана определённая группа. Возникла идея сохранить в каждый отдельный файл с именем группы только те записи, которые находятся в данной группе. Другими словами, из одного большого файла нужно сделать множество мелких, в которых находятся данные только данной группы. Была попытка сохранения файлов через фильтр, то есть вручную выбирались записи, но, очевидно, что этот вариант очень плох.
Я понимаю, как обеспечить сохранение отдельных файлов, но вот момент с выбором только необходимых записей, которые удовлетворяют данной группы и не имеют пустых строчек - другое дело.Zores
Благодарю, это обеспечило несколько идей, на основе которых можно сделать фильтрацию. Немного, правда смущает, что фильтрация проводится уже после того, как была добавлена страница. Тогда появляется вариант сделать страницу как переменную, а после сохранять её отдельно, либо после создания листов, сохранять каждый как отдельный файл.
Благодарю, это обеспечило несколько идей, на основе которых можно сделать фильтрацию. Немного, правда смущает, что фильтрация проводится уже после того, как была добавлена страница. Тогда появляется вариант сделать страницу как переменную, а после сохранять её отдельно, либо после создания листов, сохранять каждый как отдельный файл.Zores
Всё внимательно посмотрел и нашёл следующий скрипт: [vba]
Код
Sub ertert() Dim x, i&, sPath$ With Application .ScreenUpdating = False: .DisplayAlerts = False End With x = Sheets("Sheet1").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 2 To UBound(x) If Not .Exists(x(i, 1)) Then .Item(x(i, 1)) = 1 Next i: x = .keys End With On Error Resume Next: Err.Clear sPath = ThisWorkbook.Path & "\" With Sheets("Sheet1") With .Range("A1").CurrentRegion .AutoFilter For i = 0 To UBound(x) .AutoFilter Field:=1, Criteria1:=x(i) .SpecialCells(12).Copy With Workbooks.Add .Sheets(1).Range("A1").Select: .Sheets(1).Paste .Sheets(1).Range("A1").CurrentRegion.Columns.AutoFit .SaveAs Filename:=sPath & x(i), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False DoEvents: .Close End With Next i .AutoFilter End With End With With Application .CutCopyMode = False: .ScreenUpdating = True: .DisplayAlerts = True End With End Sub
[/vba] Тему можно закрыть
Всё внимательно посмотрел и нашёл следующий скрипт: [vba]
Код
Sub ertert() Dim x, i&, sPath$ With Application .ScreenUpdating = False: .DisplayAlerts = False End With x = Sheets("Sheet1").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 2 To UBound(x) If Not .Exists(x(i, 1)) Then .Item(x(i, 1)) = 1 Next i: x = .keys End With On Error Resume Next: Err.Clear sPath = ThisWorkbook.Path & "\" With Sheets("Sheet1") With .Range("A1").CurrentRegion .AutoFilter For i = 0 To UBound(x) .AutoFilter Field:=1, Criteria1:=x(i) .SpecialCells(12).Copy With Workbooks.Add .Sheets(1).Range("A1").Select: .Sheets(1).Paste .Sheets(1).Range("A1").CurrentRegion.Columns.AutoFit .SaveAs Filename:=sPath & x(i), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False DoEvents: .Close End With Next i .AutoFilter End With End With With Application .CutCopyMode = False: .ScreenUpdating = True: .DisplayAlerts = True End With End Sub