Существует проблема есть очень большой файл, с однотипными документами, необходимо разделить книгу на файлы т.е. разделить документы 1 документ = 1 файл. Копирование руками очень долгое, а кол-во строк в документах разное.
Если у кого есть идеи буду благодарен
p.s. в макросах дуб)
Добрый день.
Существует проблема есть очень большой файл, с однотипными документами, необходимо разделить книгу на файлы т.е. разделить документы 1 документ = 1 файл. Копирование руками очень долгое, а кол-во строк в документах разное.
Просто сохранение не подходить, необходимо переносить фрагменты таблицы разной длинны, предполагаю, что диапазон можно вычислять по началу и концу каждова документа. Но как это реализовать ума не приложу.
Просто сохранение не подходить, необходимо переносить фрагменты таблицы разной длинны, предполагаю, что диапазон можно вычислять по началу и концу каждова документа. Но как это реализовать ума не приложу.Chepatii
в примере прикрепленном, у каждого документа есть шапка и подвал. Ну я до конца не додумал еще, вот от безвыходности и ступора пишу к знающим людям
в примере прикрепленном, у каждого документа есть шапка и подвал. Ну я до конца не додумал еще, вот от безвыходности и ступора пишу к знающим людям Chepatii
Вы пальцем покажите что есть что Я, например, выбрал бы в качестве маркера ячейку Страница т.е. все что между двумя такими ячейками копировал в отдельный файл.
Вы пальцем покажите что есть что Я, например, выбрал бы в качестве маркера ячейку Страница т.е. все что между двумя такими ячейками копировал в отдельный файл.Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Я так понял, Вам надо сохранить в отдельный файл одну ТТН. Так может не стоит их плодить по несколько штук на один лист. Открыли шаблон, создали одну накладную, и сохранили в отдельный файл. Снова открыли шаблон и т.д. Потому как, с такой проблемой:
автоматизировать Вам, наверное, придется в разделе Работа/Фриланс.
Я так понял, Вам надо сохранить в отдельный файл одну ТТН. Так может не стоит их плодить по несколько штук на один лист. Открыли шаблон, создали одну накладную, и сохранили в отдельный файл. Снова открыли шаблон и т.д. Потому как, с такой проблемой:
Ребята подскажите, как создать формулу? Есть время, нужно перевести в десятичные. Есть волшебное "Если": 0:05*0,08 0:10*0,16 0:15*0,25 0:20*0,33 0:25*0,42 0:30*0,50 0:35*0,58 0:40*0,66 0:45*0,75 0:50*0,83 0:55*0,92 1:00*1,0
Ребята подскажите, как создать формулу? Есть время, нужно перевести в десятичные. Есть волшебное "Если": 0:05*0,08 0:10*0,16 0:15*0,25 0:20*0,33 0:25*0,42 0:30*0,50 0:35*0,58 0:40*0,66 0:45*0,75 0:50*0,83 0:55*0,92 1:00*1,0KEV
Так там yе много доработок, только копировать как раз строки с высотой, а потом столбцы форматнуть. хоть в цикле проставить щирину как у исходной таблицы. [vba]
Код
Sub OneToMany() Path = Environ("TMP") & "\" 'ïóòü ê ïàïêå Set wb = ActiveWorkbook Set ASheet = wb.ActiveSheet Cols = ActiveSheet.UsedRange.Columns.Count With wb ASheet.Cells(1, 1).Activate ifrow = 1 Do irow = .ActiveSheet.Cells.Find(What:="Унифицированная форма № ТОРГ-12", After:=ActiveCell, _ LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row On Error GoTo ex: Application.CutCopyMode = False .ActiveSheet.Rows(ifrow & ":" & irow - 1).Copy Workbooks.Add.Activate ActiveSheet.Paste 'Selection.PasteSpecial Paste:=xlPasteColumnWidths For i = 1 To Cols ActiveSheet.Columns(i).ColumnWidth = ASheet.Columns(i).ColumnWidth Next i ActiveWorkbook.SaveAs Path & irow & ".xlsx" ActiveWorkbook.Close ifrow = irow .ActiveSheet.Cells(irow, 1).Activate Loop Until irow = Empty End With ex: End Sub
[/vba]
Пропишите Path = пропишите нужный путь.
sboy,
Так там yе много доработок, только копировать как раз строки с высотой, а потом столбцы форматнуть. хоть в цикле проставить щирину как у исходной таблицы. [vba]
Код
Sub OneToMany() Path = Environ("TMP") & "\" 'ïóòü ê ïàïêå Set wb = ActiveWorkbook Set ASheet = wb.ActiveSheet Cols = ActiveSheet.UsedRange.Columns.Count With wb ASheet.Cells(1, 1).Activate ifrow = 1 Do irow = .ActiveSheet.Cells.Find(What:="Унифицированная форма № ТОРГ-12", After:=ActiveCell, _ LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row On Error GoTo ex: Application.CutCopyMode = False .ActiveSheet.Rows(ifrow & ":" & irow - 1).Copy Workbooks.Add.Activate ActiveSheet.Paste 'Selection.PasteSpecial Paste:=xlPasteColumnWidths For i = 1 To Cols ActiveSheet.Columns(i).ColumnWidth = ASheet.Columns(i).ColumnWidth Next i ActiveWorkbook.SaveAs Path & irow & ".xlsx" ActiveWorkbook.Close ifrow = irow .ActiveSheet.Cells(irow, 1).Activate Loop Until irow = Empty End With ex: End Sub