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

Вход

Регистрация

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

 

= Мир MS Excel/Разнесение по критерию в отдельные файлы - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Разнесение по критерию в отдельные файлы
Chepatii Дата: Четверг, 05.01.2017, 12:11 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день.

Существует проблема есть очень большой файл, с однотипными документами, необходимо разделить книгу на файлы т.е. разделить документы 1 документ = 1 файл.
Копирование руками очень долгое, а кол-во строк в документах разное.

Если у кого есть идеи буду благодарен

p.s. в макросах дуб)
 
Ответить
СообщениеДобрый день.

Существует проблема есть очень большой файл, с однотипными документами, необходимо разделить книгу на файлы т.е. разделить документы 1 документ = 1 файл.
Копирование руками очень долгое, а кол-во строк в документах разное.

Если у кого есть идеи буду благодарен

p.s. в макросах дуб)

Автор - Chepatii
Дата добавления - 05.01.2017 в 12:11
Pelena Дата: Четверг, 05.01.2017, 12:26 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19603
Репутация: 4660 ±
Замечаний: ±

Excel 365 & Mac Excel
Здравствуйте.
Посмотрите Готовое решение


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Посмотрите Готовое решение

Автор - Pelena
Дата добавления - 05.01.2017 в 12:26
Chepatii Дата: Четверг, 05.01.2017, 12:29 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Просто сохранение не подходить, необходимо переносить фрагменты таблицы разной длинны, предполагаю, что диапазон можно вычислять по началу и концу каждова документа.
Но как это реализовать ума не приложу.
 
Ответить
СообщениеПросто сохранение не подходить, необходимо переносить фрагменты таблицы разной длинны, предполагаю, что диапазон можно вычислять по началу и концу каждова документа.
Но как это реализовать ума не приложу.

Автор - Chepatii
Дата добавления - 05.01.2017 в 12:29
Chepatii Дата: Четверг, 05.01.2017, 12:31 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Не вижу, прикрепился ли файл.
К сообщению приложен файл: 3778573.xlsx (74.7 Kb)


Сообщение отредактировал Chepatii - Четверг, 05.01.2017, 12:32
 
Ответить
СообщениеНе вижу, прикрепился ли файл.

Автор - Chepatii
Дата добавления - 05.01.2017 в 12:31
Udik Дата: Четверг, 05.01.2017, 12:59 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
предполагаю, что диапазон можно вычислять по началу и концу каждова документа.

А как это обозначается?


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщение
предполагаю, что диапазон можно вычислять по началу и концу каждова документа.

А как это обозначается?

Автор - Udik
Дата добавления - 05.01.2017 в 12:59
Chepatii Дата: Четверг, 05.01.2017, 13:09 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
в примере прикрепленном, у каждого документа есть шапка и подвал. Ну я до конца не додумал еще, вот от безвыходности и ступора пишу к знающим людям :D
 
Ответить
Сообщениев примере прикрепленном, у каждого документа есть шапка и подвал. Ну я до конца не додумал еще, вот от безвыходности и ступора пишу к знающим людям :D

Автор - Chepatii
Дата добавления - 05.01.2017 в 13:09
Udik Дата: Четверг, 05.01.2017, 13:21 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
есть шапка и подвал.

Вы пальцем покажите что есть что :) Я, например, выбрал бы в качестве маркера ячейку Страница т.е. все что между двумя такими ячейками копировал в отдельный файл.


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщение
есть шапка и подвал.

Вы пальцем покажите что есть что :) Я, например, выбрал бы в качестве маркера ячейку Страница т.е. все что между двумя такими ячейками копировал в отдельный файл.

Автор - Udik
Дата добавления - 05.01.2017 в 13:21
Wasilich Дата: Четверг, 05.01.2017, 13:51 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 1232
Репутация: 326 ±
Замечаний: 0% ±

2003
Я так понял, Вам надо сохранить в отдельный файл одну ТТН. Так может не стоит их плодить по несколько штук на один лист. Открыли шаблон, создали одну накладную, и сохранили в отдельный файл. Снова открыли шаблон и т.д.
Потому как, с такой проблемой:
p.s. в макросах дуб)
автоматизировать Вам, наверное, придется в разделе Работа/Фриланс.
 
Ответить
СообщениеЯ так понял, Вам надо сохранить в отдельный файл одну ТТН. Так может не стоит их плодить по несколько штук на один лист. Открыли шаблон, создали одну накладную, и сохранили в отдельный файл. Снова открыли шаблон и т.д.
Потому как, с такой проблемой:
p.s. в макросах дуб)
автоматизировать Вам, наверное, придется в разделе Работа/Фриланс.

Автор - Wasilich
Дата добавления - 05.01.2017 в 13:51
sboy Дата: Четверг, 05.01.2017, 14:10 | Сообщение № 9
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Вот вариант[vba]
Код
Sub OneToMany()
Path = Environ("TMP") & "\" 'путь к папке
Set wb = ActiveWorkbook
With wb
.ActiveSheet.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.Range(Cells(ifrow, 1), Cells(irow - 1, 39)).Copy
    Workbooks.Add.Activate
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
    ActiveWorkbook.SaveAs Path & irow & ".xlsx"
    ActiveWorkbook.Close
ifrow = irow
.ActiveSheet.Cells(irow, 1).Activate
Loop Until irow = Empty
End With
ex:
End Sub
[/vba]
Если эти документы предполагается потом печатать, то надо дорабатывать, т.к. высота строк при копировании не сохраняется
К сообщению приложен файл: 3778573.xlsm (83.7 Kb)


Яндекс: 410016850021169
 
Ответить
СообщениеДобрый день.
Вот вариант[vba]
Код
Sub OneToMany()
Path = Environ("TMP") & "\" 'путь к папке
Set wb = ActiveWorkbook
With wb
.ActiveSheet.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.Range(Cells(ifrow, 1), Cells(irow - 1, 39)).Copy
    Workbooks.Add.Activate
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
    ActiveWorkbook.SaveAs Path & irow & ".xlsx"
    ActiveWorkbook.Close
ifrow = irow
.ActiveSheet.Cells(irow, 1).Activate
Loop Until irow = Empty
End With
ex:
End Sub
[/vba]
Если эти документы предполагается потом печатать, то надо дорабатывать, т.к. высота строк при копировании не сохраняется

Автор - sboy
Дата добавления - 05.01.2017 в 14:10
Chepatii Дата: Четверг, 05.01.2017, 16:19 | Сообщение № 10
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Я так понял, Вам надо сохранить в отдельный файл одну ТТН


именно так

Если эти документы предполагается потом печатать, то надо дорабатывать, т.к. высота строк при копировании не сохраняется


нет их надо будет загрузить в 1с думаю высота не играет роли
 
Ответить
Сообщение
Я так понял, Вам надо сохранить в отдельный файл одну ТТН


именно так

Если эти документы предполагается потом печатать, то надо дорабатывать, т.к. высота строк при копировании не сохраняется


нет их надо будет загрузить в 1с думаю высота не играет роли

Автор - Chepatii
Дата добавления - 05.01.2017 в 16:19
Chepatii Дата: Четверг, 05.01.2017, 16:35 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Вот вариант


разделил, но вот сохраняет в папку Temp ))) вылавливать кучу файлов приходится от туда)
 
Ответить
Сообщение
Добрый день.
Вот вариант


разделил, но вот сохраняет в папку Temp ))) вылавливать кучу файлов приходится от туда)

Автор - Chepatii
Дата добавления - 05.01.2017 в 16:35
KEV Дата: Четверг, 05.01.2017, 16:38 | Сообщение № 12
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Ребята подскажите, как создать формулу? Есть время, нужно перевести в десятичные. Есть волшебное "Если":
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,0

Автор - KEV
Дата добавления - 05.01.2017 в 16:38
bmv98rus Дата: Четверг, 05.01.2017, 17:01 | Сообщение № 13
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4149
Репутация: 772 ±
Замечаний: 0% ±

Excel 2013/2016
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
[/vba]

Пропишите Path = пропишите нужный путь.


Замечательный Временно просто медведь , процентов на 20.

Сообщение отредактировал bmv98rus - Четверг, 05.01.2017, 18:22
 
Ответить
Сообщение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
[/vba]

Пропишите Path = пропишите нужный путь.

Автор - bmv98rus
Дата добавления - 05.01.2017 в 17:01
Chepatii Дата: Четверг, 05.01.2017, 17:10 | Сообщение № 14
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
ропишите Path = пропишите нужный путь.


спасибо всем огромное, все работает супер, 1с принимает на ура!!!!
 
Ответить
Сообщение
ропишите Path = пропишите нужный путь.


спасибо всем огромное, все работает супер, 1с принимает на ура!!!!

Автор - Chepatii
Дата добавления - 05.01.2017 в 17:10
  • Страница 1 из 1
  • 1
Поиск:

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