Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
Разделение файла на несколько по заданному критерию
 
#1
28.09.2010 14:19:54
Добрый день!  
Снова очень необходима Ваша помощь, попробовала поискать через поиск не получилось.  
Поэтому обращаюськ Вам:  
Есть файл с несколькими столбцами (1 лист в файле): Филиал, ФИО, Сумма, дата, и т.д.  
Данный файл необходимо  разбить по филиалам на несколько файлов, которые будут соответствовать определенному филиалу, соответвенно  в каждом новом файле должен быть 1 филиал с перечислением данных, которые соответствуют конкретному филиалу.  
 
Заранее очень благодарю.
 
 
 
#2
28.09.2010 14:58:29
неужели спасенья нет?
 
 
 
#3
28.09.2010 15:08:42
Есть спасенье...  
Но вот вопрос по теме - никто не подскажет, какой длины допустимо Item в Dictionary? :)  
Можно туда тысячи номеров строк положить? Подозреваю, что нет...
 
 
 
#4
28.09.2010 15:15:49
Хотя проверил - до 65500 строк обработало. Поразительно...
 
 
 
#5
28.09.2010 15:17:15
{quote}{login=Hugo}{date=28.09.2010 03:08}{thema=}{post}Есть спасенье...  
Но вот вопрос по теме - никто не подскажет, какой длины допустимо Item в Dictionary? :)  
Можно туда тысячи номеров строк положить? Подозреваю, что нет...{/post}{/quote}  
 
к сожаление я ничего не поняла.  
или вопрос не мне  
список сколько всего филиалов - он ограничен  
сколько строк в базе - около 30 000
 
 
 
#6
28.09.2010 15:17:39
Вопрос к Alexandra - Вам надо в новые файлы только информацию перенести, или и форматирпование тоже?
 
 
 
#7
28.09.2010 15:18:05
{quote}{login=Hugo}{date=28.09.2010 03:15}{thema=}{post}Хотя проверил - до 65500 строк обработало. Поразительно...{/post}{/quote}  
 
))) так
 
 
 
#8
28.09.2010 15:19:02
Да, про Dictionary вопрос был к знатокам, я по-быстрому ответ не нашёл, но опытным путём установил, что лезет много...
 
 
 
#9
28.09.2010 15:22:37
{quote}{login=Hugo}{date=28.09.2010 03:17}{thema=}{post}Вопрос к Alexandra - Вам надо в новые файлы только информацию перенести, или и форматирпование тоже?{/post}{/quote}  
 
С форматирование  
но если без вариантов то можно без
 
 
 
#10
28.09.2010 15:32:20
Игорь, а нафига тут Dictionary?  
По-моему, задача 1:1 как в этой теме, только номера столбцов поменять...  
 
http://www.planetaexcel.ru/forum.php?thread_id=19138
 
 
 
#11
28.09.2010 15:32:56
Без форматирования быстрее, намного быстрее. Т.е. красочная шапка, ниже данные, без шрифтов, раскраски, рамок... хотя рамки можно и натянуть...
 
 
 
#12
28.09.2010 15:34:12
Вечером могу, наверное, выложить файл примера если не удалил за ненадобностью. Делал подобное - сначала уникальные, потом перебор автофильтром по уникальным с копированием в новый файл...  
Игорь67
 
 
 
#13
28.09.2010 15:37:27
{quote}{login=Казанский}{date=28.09.2010 03:32}{thema=}{post}Игорь, а нафига тут Dictionary?  
По-моему, задача 1:1 как в этой теме, только номера столбцов поменять...  
 
http://www.planetaexcel.ru/forum.php?thread_id=19138{/post}{/quote}  
 
Похоже, я тоже сразу подумал - было похожее... Но там районы известны, тут пока нет. Поэтому я собираю в словарь уникальные со списком их строк, а затем перекопирую эти строки по файлам. Пока план такой. Половину сделал.
 
 
 
#14
28.09.2010 15:40:39
> Половину сделал  
 
Ну, успехов. Хотя в той теме районы брал прямо из данных, а не из отдельного списка.
 
 
 
#15
28.09.2010 15:54:53
У меня так получилось, как вариант (на основе макрорекордера):  
 
Private Sub CommandButton1_Click()  
Dim path1 As String, str_krit As String, nam As String  
Dim li As Long  
Dim wb1 As Workbook  
 
Application.ScreenUpdating = False  
path1 = ActiveWorkbook.Path  
Set wb1 = ActiveWorkbook  
 While Cells(2, 2).Value <> ""  
   nam = Cells(2, 2).Value  
   Range("B2").Select  
   Selection.AutoFilter Field:=2, Criteria1:=Cells(2, 2).Value  
   Cells.Select  
   Selection.Copy  
   Workbooks.Add  
   ActiveSheet.Paste  
   ActiveWorkbook.SaveAs Filename:=path1 & "\" & nam & ".xls"  
   ActiveWorkbook.Close  
   wb1.Activate  
   str_krit = "2:" & Rows.Count  
   Rows(str_krit).Delete Shift:=xlUp  
 Wend  
     
Application.ScreenUpdating = True  
     
End Sub
 
 
 
#16
28.09.2010 16:17:12
Добил... Но на большом количестве строк надо бы проверить, все ли скопировались.  
Мои файлы по 13-14 кб получаются, после рекордера по 3 мб.  
Рамку не делал.
 
 
 
#17
28.09.2010 16:23:03
{quote}{login=Grin23}{date=28.09.2010 03:54}{thema=}{post}У меня так получилось, как вариант (на основе макрорекордера):  
 
Private Sub CommandButton1_Click()  
Dim path1 As String, str_krit As String, nam As String  
Dim li As Long  
Dim wb1 As Workbook  
 
Application.ScreenUpdating = False  
path1 = ActiveWorkbook.Path  
Set wb1 = ActiveWorkbook  
 While Cells(2, 2).Value <> ""  
   nam = Cells(2, 2).Value  
   Range("B2").Select  
   Selection.AutoFilter Field:=2, Criteria1:=Cells(2, 2).Value  
   Cells.Select  
   Selection.Copy  
   Workbooks.Add  
   ActiveSheet.Paste  
   ActiveWorkbook.SaveAs Filename:=path1 & "\" & nam & ".xls"  
   ActiveWorkbook.Close  
   wb1.Activate  
   str_krit = "2:" & Rows.Count  
   Rows(str_krit).Delete Shift:=xlUp  
 Wend  
     
Application.ScreenUpdating = True  
     
End Sub{/post}{/quote}  
 
Все сотрудники нашей компании говорят вам спасибо!!!! огромное  
все 30000 человек!
 
 
 
#18
28.09.2010 16:24:01
{quote}{login=Hugo}{date=28.09.2010 04:17}{thema=}{post}Добил... Но на большом количестве строк надо бы проверить, все ли скопировались.  
Мои файлы по 13-14 кб получаются, после рекордера по 3 мб.  
Рамку не делал.{/post}{/quote}  
 
СПасибо Вам огромное вы просто супер!
 
 
 
#19
28.09.2010 17:19:05
Я бы это сделал с помощью сводной.  
зы. если компаний 30-40, то вручную быстрее, чем писать макрос.
 
 
 
#20
29.09.2010 02:18:09
Ну и мой пятачок. Че вы все так любите усложнять... Макрос одноразовый. Со всеми форматами. Вызывается ctrl+k.
Я сам - дурнее всякого примера! ...
 
 
 
#21
29.09.2010 18:16:45
Теперь задним числом усложнили задачу  
Попросили чтоб через пару строк писалось  
"Руководитель направления льгот    
и служебной сотовой связи, Россия"  
 
Такое возможно?  
т.к. все это будет распечатываться и под подпись
 
 
 
#22
29.09.2010 18:28:30
Возможно. В любом из макросов (кроме сводной, но и там руками можно добавить) находите в коде место после копирования, определяете количество скопированных строк (в моём точно есть такая переменная) и добавляете ниже свой текст в нужную ячейку.  
Так какой способ выбрали? Тому и делать :)
 
 
 
#23
29.09.2010 18:35:25
{quote}{login=Hugo}{date=29.09.2010 06:28}{thema=}{post}Возможно. В любом из макросов (кроме сводной, но и там руками можно добавить) находите в коде место после копирования, определяете количество скопированных строк (в моём точно есть такая переменная) и добавляете ниже свой текст в нужную ячейку.  
Так какой способ выбрали? Тому и делать :){/post}{/quote}  
 
я так сама не смогу... хоть режте меня)
 
 
 
#24
29.09.2010 18:47:11
Alexandra а сказать кому и какой макрос дорабатывать можете?  
Игорь67
 
 
 
#25
29.09.2010 20:15:38
Пристальнее посмотрел - Grin23 отпадает, остаюсь я да пятачок :).  
Кого выберете?
 
 
 
#26
29.09.2010 20:26:23
У меня вот, добавлена средняя строка:  
 
.Sheets(1).Range("A2:J" & x + 1) = b  
.Sheets(1).Range("A" & x + 3) = "Руководитель направления льгот и служебной сотовой связи, Россия"  
x = 0  
 
Можно ещё жирность на этом Range навести или шрифт покрупнее и другой поставить:  
 
.Sheets(1).Range("A2:J" & x + 1) = b  
.Sheets(1).Range("A" & x + 3) = "Руководитель направления льгот и служебной сотовой связи, Россия"  
.Sheets(1).Range("A" & x + 3).Font.Bold = True  
.Sheets(1).Range("A" & x + 3).Font.Size = 12  
.Sheets(1).Range("A" & x + 3).Font.Name = "Gungsuh"  
x = 0
 
 
 
#27
29.09.2010 21:50:01
Ну, раз пошла такая пьянка... добавил и рамку, и AutoFit, и место для подписи,  и лист развернул для печати, и отключил этот глупый шрифт и размер :)  
Подозреваю, что ещё и шапку надо бы добавить...
 
 
 
#28
30.09.2010 01:14:22
Игорь, мой пошустрей почему-то. И формат твой не выдерживает(коверкает заголовки). И объем у моих файлов поменьше.  
 
22292 каре?
Я сам - дурнее всякого примера! ...
 
 
 
#29
30.09.2010 03:10:46
Отключил у тебя PageSetup - быстрей побежал. А с размером и форматами...:-(  
=22622=
Я сам - дурнее всякого примера! ...
 
 
 
#30
30.09.2010 09:17:07
Поспорю - с размером у меня как-раз наоборот, мои меньше (Челябинский.xls 15872 vs 17408).  
С форматом - вот как раз ws.[A1].PasteSpecial Paste:=xlPasteColumnWidths у меня на 2000 не работает. Это можно и в мой код вставить (на другом офисе) - будет как у тебя, я так же заголовки копирую, как есть.
Ну а PageSetup всеж надо, раз на печать. Ну или задавать сразу разбивку листа под печать - так, как по умолчанию, не годится.
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх