Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
отсортировать и разбить таблицу на несколько файлов
 
#1
20.05.2011 13:36:21
Здравствуйте, уважаемые экперты!  
Прошу Вашей помоши!!!  
Задача заключается в следующем:    
 
есть исходная таблица excel с различными столбцами, один из столбцов содержит адреса в третьем столбце, которые начинаются с названия города (например: Москва ул Ленина д 4 кв 5), города различные;  
 
нужно: определить какие города присутствуют в данной таблице и сохранить все поля по городам в разные файлы(например: все поля у которых адрес начинается с Москва в 1-ый файл,все поля у которых адрес начинается с Иркутск во 2-ой файл и так далее )  
 
Заранее известны какие города могут быть в адресе(например 5:москва, иркутск, пенза, тверь, новгород); но не все города могут быть в исходной таблице (напрмер только москва, иркутск, пенза, должно сформироваться 3 файла )
 
 
 
#2
20.05.2011 13:43:53
Отсортировать и скопипастить руками не выход?  
Если делать всё автоматом - как отличить "Ростов" от "Ростов На Дону" например? Можно смотреть до "ул", но как быть с "пер", "пр" и т.д.?  
Может быть есть перечень возможных городов?  
Я бы делал вручную, если городов десяток и делать нужно не каждый день...
 
 
 
#3
20.05.2011 13:48:06
нужно автоматизаровать, файлов много)))города все разные, совпадение не возможно))самое главное в ячейке "адрес" определить какой город , остальное неважно(я это пытаюсь делать с помощью InStr(1, array_city(j), "C:i")  )
 
 
 
#4
20.05.2011 15:14:06
По мне, так тут основная проблема - однозначно определить город.  
Мы данные не видим, но если там после каждого города 100% идёт "C:i", то проблем уже никаких нет.  
Но чуть выше Вы писали: "Москва ул Ленина д 4 кв 5"...
 
 
 
#5
20.05.2011 16:09:04
{quote}{login=Hugo}{date=20.05.2011 03:14}{thema=}{post}По мне, так тут основная проблема - однозначно определить город.  
Мы данные не видим, но если там после каждого города 100% идёт "C:i", то проблем уже никаких нет.  
Но чуть выше Вы писали: "Москва ул Ленина д 4 кв 5"...{/post}{/quote}  
 
 
1)есть конкретный список городов которые могут (но могут и не быть) в таблице, все города различные, совпадений быть не может;  
2)главное определить какой город входит в адресную строку;  
3) "C:i" это адрес третьего столбца и i-ой строки,  для которой я пытаюсь определить вхождение определенного города(все города я забила в строковый массив);
 
 
 
#6
20.05.2011 16:18:08
> InStr(1, array_city(j), "C:i") )  
 
Наверно, все-таки InStr(1, array_city(j), cells(i, "C"), vbTextCompare)  
или  
If array_city(j) Like "*" & cells(i, "C") & "*" then
 
 
 
#7
20.05.2011 16:25:11
Тогда я думаю нужно города поместить в VBA массив, и его перебором по InStr() искать совпадения по текущей строке.  
Только в этом списке сперва должны идти города типа "Ростов на Дону", а потом "Ростов", если конечно есть такие, раздельно написанные.  
Я бы наверное так сделал:  
1. список городов в массив  
2. в массив анализируемые данные  
3. цикл в цикле перебираем массивы  
4. при совпадении помещаем город в словарь, как item заводим массив размером с исходный (чтоб хватило), в него данные найденной строки и индекс  
5. при повторном совпадении пополняем массив этого города  
6. в конце перебираем словарь, генерим файлы, выгружаем массивы (по индексам), сохраняем  
 
Вроде нормально, только мне не нравится большой расход ресурсов на массивы в словаре. Но Redim Preserve как-то тоже не по душе... Если не хватит памяти, придётся жертвовать скоростью.
 
 
 
#8
20.05.2011 16:25:49
{quote}{login=Казанский}{date=20.05.2011 04:18}{thema=}{post}> InStr(1, array_city(j), "C:i") )  
 
Наверно, все-таки InStr(1, array_city(j), cells(i, "C"), vbTextCompare)  
или  
If array_city(j) Like "*" & cells(i, "C") & "*" then{/post}{/quote}  
 
спасибо))а подскажите пожалуйста еще))я открываю файл excel следующим образом:  
 
Dim oWbk As Workbook  
Set oWbk = Workbooks.Open("D:\База плательщиков\ab_trg.xls")    
 
как определить в открывшемся файле количество непустых строк?  
заранее ПРЕОГРОМНЕЙШЕЕ СПАСИБО!!!!
 
 
 
#9
20.05.2011 16:36:01
Такие похожие варианты, смотрят по определённому столбцу (но не в файле, а в одном из листов файла):  
 
1.  
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row  
 
2.  
With ActiveSheet  
If .FilterMode Then .ShowAllData  
iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row  
End With  
 
3.  
iLastRow = Range("A" & Rows.Count).End(IIf(Len(Range("A" & Rows.Count)), xlDown, xlUp)).Row  
 
 
В общем, это самые ходовые и правильные для большинства задач.
 
 
 
#10
20.05.2011 16:37:28
Я бы сделал  через ADO, и фильтр рекордсета.  
что то похожее недавно делал, только данные по листам разбрасывал
Спасибо
 
 
 
#11
20.05.2011 16:44:26
{quote}{login=Hugo}{date=20.05.2011 04:25}{thema=}{post}  
Только в этом списке сперва должны идти города типа "Ростов на Дону", а потом "Ростов", если конечно есть такие, раздельно написанные.  
{/post}{/quote}  
отсортировать массив по убыванию - не вариант?
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#12
20.05.2011 16:51:06
Да, можно кодом сперва отсортировать, чтоб вручную не следить.  
А можно вручную отсортировать :)  
 
На ADO вероятно экономичнее будет.  
Тогда сперва просто сотавляем словарь присутствующих городов, потом его перебором фильтруем данные как R Dmitry сказал.  
Я с ADO мало дела имел...
 
 
 
#13
20.05.2011 16:56:20
Ну если старттопика заинтересет то тема вот здесь  
 
http://www.planetaexcel.ru/forum.php?thread_id=27439  
там разноситься по листам, переделать по файлам не составит труда
Спасибо
 
 
 
#14
20.05.2011 17:05:15
Хм, по Instr() по всей строке могут быть проблемы - например, город Саратов, улица Ростовская. Нужно однозначно смотреть, чтоб Instr()=1
 
 
 
#15
23.05.2011 09:30:50
Спасибо всем громное за ответы  
Мне осталось разобраться в нескольких строках:  
 
в 17) не уверена что  срабатывает InStr чтобы проверить входит ли город  array_city1(i) в ячейку Cells(j, "C")  
 
в 27) строке нужно создать новый файл с одним листом  
 
в 29) произвести запись найденной строки в созданный файл  
 
в 31) сохранить созданный файл  
 
 
вто код программы  
1)  Private Sub CommandButton1_Click()  
2)  Dim i As Integer, n As Integer, j As Integer, kol As Integer  
3)  Dim array_city(1 To 5) As String  
4)  Dim array_city1() As String  
5)  Dim oWbk As Workbook  
6)  Set oWbk = Workbooks.Open("D:\База плательщиков\ab_trg.xls")  
7)  n = Cells(Rows.Count, 1).End(xlUp).Row  
8)  MsgBox n  
9)  array_city(1) = "Осташков"  
10) array_city(2) = "Лихославль"  
11) array_city(3) = "Кесова"  
12) array_city(4) = "Западная"  
13) array_city(5) = "Бологое"  
14) kol = 0  
15) For i = 2 To n ' считаем кол-во различных городов в файле  
16)   For j = 1 To 5  
17)       If InStr(1, array_city(j), Cells(i, "C"), vbTextCompare) <> 0 Then  
18)  kol=kol+1 'считаю количество городов в новом массиве  
19)array_city1(kol) = array_city(j) 'формирую масссив из названий городов найденных в таблице  
20)MsgBox array_city(j)  
21)Exit For 'если город найден в строке, то нет необходимости проверять дальше все города, поетому выходим из цикла по j и переходим к следующей строке и уже для нее опять проверяем города  
22)       End If  
23)  Next j  
24)Next i  
25)MsgBox kol  
26)For i = 1 To kol  
27) 'здесь нужно созать новый файл куда будем записывать все строки в которых есть i-город  
28)  For j = 2 To n  
29)    If InStr(1, array_city1(i), Cells(j, "C")) <> 0 Then 'запись всей строки j-ой (она состоит из 10 столбцов) в созданный файл  
30)  Next j  
31)  'здесь нужно сохранить созданный и уже сформированный файл  
32)Next i  
33)End Sub
 
 
 
#16
23.05.2011 09:32:50
{quote}{login=Hugo}{date=20.05.2011 04:36}{thema=}{post}Такие похожие варианты, смотрят по определённому столбцу (но не в файле, а в одном из листов файла):  
 
1.  
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row  
 
2.  
With ActiveSheet  
If .FilterMode Then .ShowAllData  
iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row  
End With  
 
3.  
iLastRow = Range("A" & Rows.Count).End(IIf(Len(Range("A" & Rows.Count)), xlDown, xlUp)).Row  
 
 
В общем, это самые ходовые и правильные для большинства задач.{/post}{/quote}  
 
спасибо за помощь!!!помог 1-ый вариант  
не могли бы вы посоветовать хорошие книги где я сама могла бы найти все что вы мне посоветовали?
 
 
 
#17
23.05.2011 09:47:57
По п. 17 нужно наоборот, искать город из массива в ячейке, и смотреть, чтоб он был первым в строке ячейки:  
17) If InStr(Cells(i, "C"), array_city(j), vbTextCompare) = 1 Then  
А по книгам - гляньте http://www.excelworld.ru/index/biblioteka/0-5  
или www.firststeps.ru тоже доходчиво, и с примерами иногда...
 
 
 
#18
23.05.2011 10:08:40
Единичку пропустил (без неё оказывается vbTextCompare не идёт):  
If InStr(1, Cells(i, "A"), array_city(j), vbTextCompare) = 1 Then
 
 
 
#19
23.05.2011 10:19:31
Смотрю код - есть что исправить...  
Но вопрос по алгоритму - зачем составлять массив найденных городов?  
Ведь можно сразу, как нашли, копировать строку в другой файл, не собирая города в массив (кстати, в коде это не работает, иначе делать нужно).
 
 
 
#20
23.05.2011 10:23:44
{quote}{login=Hugo}{date=23.05.2011 10:19}{thema=}{post}Смотрю код - есть что исправить...  
Но вопрос по алгоритму - зачем составлять массив найденных городов?  
Ведь можно сразу, как нашли, копировать строку в другой файл, не собирая города в массив (кстати, в коде это не работает, иначе делать нужно).{/post}{/quote}  
 
заранее не известно сколько файлов надо создавать
 
 
 
#21
23.05.2011 10:26:27
Упс, вопрос снимается - перечитал первый пост :)  
Но я иначе планировал алгоритм - там словарь предусматривался.  
Но можно вероятно и так - перебирать по многу раз - сперва выявить присуствующие города, потом отбирать по каждому городу...  
Но лучше действительно на ADO делать - будет быстрее.
 
 
 
#22
23.05.2011 10:27:40
{quote}{login=Hugo}{date=23.05.2011 10:26}{thema=}{post}Упс, вопрос снимается - перечитал первый пост :)  
Но я иначе планировал алгоритм - там словарь предусматривался.  
Но можно вероятно и так - перебирать по многу раз - сперва выявить присуствующие города, потом отбирать по каждому городу...  
Но лучше действительно на ADO делать - будет быстрее.{/post}{/quote}  
 
 
к сожалению не знаю как работать с ADO
 
 
 
#23
23.05.2011 10:56:29
Я тоже мало работал, может Дмитрий покажет.  
А по этому алгоритму:  
при таком алгоритме (да и на словаре тоже, я сперва не додумал), чтоб побороть "проблему Ростова" - нужно в итоге строки не копировать, а переносить.  
Вы получите например массив  
"Ростов-На-Дону  
Ростов"  
Потом перебором этого массива отберёте строки с "Ростов-На-Дону", а затем при отборе по "Ростову" строк с "Ростов-На-Дону" уже быть не должно.
 
 
 
#24
23.05.2011 11:30:43
Наладил, работает.  
Но запись в файл пока не делал, т.к.:  
для теста в файле C:\ab_trg.xls в столбце А следующие города:  
Осташков  
Лихославль  
Ростов -На - Дону  
Ростов  
Бологое  
при таких данных строка  
MsgBox oWbsh.Cells(j, "A") & "->" & array_city(i)  
показывает, что в файл будут отбираться некорректные данные, это нужно решать  
 
'1)  
Private Sub CommandButton1_Click()  
'2)  
Dim i As Long, n As Long, j As Long, kol As Long 'лучше as long, чтоб наверняка хватило, тем более что всё равно экономии памяти нет...  
'3)  
Dim array_city(1 To 5) As String  
'4)  
ReDim array_city1(0) As String  
'5)  
Dim oWbsh As Worksheet 'будем обращаться сразу к листу  
'6)  
Set oWbsh = Workbooks.Open("C:\ab_trg.xls").Sheets(1)  
'7)  
n = oWbsh.Cells(Rows.Count, 1).End(xlUp).Row  
'8)  
MsgBox n  
'9)  
array_city(1) = "Осташков"  
'10)  
array_city(2) = "Лихославль"  
'11)  
array_city(3) = "Ростов-На-Дону"  
'12)  
array_city(4) = "Ростов"  
'13)  
array_city(5) = "Бологое"  
'14)  
kol = 0  
'15)  
   For i = 2 To n ' считаем кол-во различных городов в файле  
   '16)  
       For j = 1 To 5  
       '17)  
           If InStr(1, oWbsh.Cells(i, "A"), array_city(j), vbTextCompare) = 1 Then  
               '18)  
               kol = kol + 1 'считаю количество городов в новом массиве  
               '19)  
               ReDim Preserve array_city1(UBound(array_city1) + 1) 'увеличиваем массив, нулевой элемент останется пустым  
               array_city1(kol) = array_city(j) 'формирую масссив из названий городов найденных в таблице  
               '20)  
               MsgBox array_city(j)  
               '21)  
               Exit For 'если город найден в строке, то нет необходимости проверять дальше все города, поетому выходим из цикла по j и переходим к следующей строке и уже для нее опять проверяем города  
           '22)  
           End If  
       '23)  
       Next j  
   '24)  
   Next i  
'25)  
MsgBox kol  
'26)  
For i = 1 To kol  
'27)  
'здесь нужно созать новый файл куда будем записывать все строки в которых есть i-город  
'28)  
For j = 2 To n  
'29)  
If InStr(1, oWbsh.Cells(j, "A"), array_city(i), vbTextCompare) = 1 Then  
MsgBox oWbsh.Cells(j, "A") & "->" & array_city(i) 'запись всей строки j-ой (она состоит из 10 столбцов) в созданный файл  
End If  
'30)  
Next j  
'31)  
'здесь нужно сохранить созданный и уже сформированный файл  
'32)  
Next i  
End Sub
 
 
 
#25
23.05.2011 11:33:03
{quote}{login=Hugo}{date=23.05.2011 10:56}{thema=}{post}Я тоже мало работал, может Дмитрий покажет.  
А по этому алгоритму:  
при таком алгоритме (да и на словаре тоже, я сперва не додумал), чтоб побороть "проблему Ростова" - нужно в итоге строки не копировать, а переносить.  
Вы получите например массив  
"Ростов-На-Дону  
Ростов"  
Потом перебором этого массива отберёте строки с "Ростов-На-Дону", а затем при отборе по "Ростову" строк с "Ростов-На-Дону" уже быть не должно.{/post}{/quote}  
Игорь и старттопик, с удовольствием Вам покажу как это сделать, но..... самому пример ваять, набивать адреса и т.д. мне честно не очень хочеться  
 
В ссылке что я давал идет создание листов, и фильтр рекордсета отбирает по точному критерию записи, он воспринимает также и знаки подстановки,  
поэтому фильтр с like отлично дружат, можно также при формировании рекордсета, отсечь допустим 15 первых символов (или сколько надо), и по ним фильтровать рекордсет.    
Если бы старттопик показал все же пример, возможно еще что нибудь придумалось.... :)  
но ошибки конечно же могут быть Псков и Псковская область, хотя и такие ошибки можно впринципе допилить, проверкой следующего символа.  
Ну если примера не будет, то сварганю маленький пример, только из уважения к Игорю.
Спасибо
 
 
 
#26
23.05.2011 11:48:11
Ну я тоже сам себе пример сварганил, маленький :)  
Я пока с этим алгоритмом вожусь, с надеждой, что не ради результата (лучше на АДО делать), а в целях практики и обучения.  
Хотя тоже вариант рабочий может получиться, но неоптимальный.  
 
Предлагаю - в объявлении переменных так:  
Dim oWb As Workbook, oWbsh As Worksheet  
Set oWb = Workbooks.Open("C:\ab_trg.xls")  
Set oWbsh = oWb.Sheets(1)  
 
Далее этот цикл так:  
For j = 2 To n  
If InStr(1, oWbsh.Cells(j, "A"), array_city(i), vbTextCompare) = 1 Then  
MsgBox oWbsh.Cells(j, "A") & "->" & array_city(i) 'запись всей строки j-ой (она состоит из 10 столбцов) в созданный файл  
oWbsh.Cells(j, "A") = Empty 'очищаем найденную строку  
End If  
Next j  
 
И тогда в конце  
oWb.Close 0 'закрываем файл без сохранения, это обязательно, т.к. он испорчен  
End Sub  
 
Можно избежать порчи файла, если исходные данные брать в массив и затем перебирать и модифицировать его.  
Это не только безопасно для исходного файла, но и в десятки раз ускоряет код.  
Позже покажу :)
 
 
 
#27
23.05.2011 12:10:08
На втором (вернее уже третьем) массиве так:  
 
 
Private Sub CommandButton3_Click()  
Dim i As Long, n As Long, j As Long, kol As Long 'лучше as long, чтоб наверняка хватило, тем более что всё равно экономии памяти нет...  
Dim array_city(1 To 5) As String  
ReDim array_city1(0) As String  
Dim DataArr()  
Dim oWb As Workbook, oWbsh As Worksheet  
Set oWb = Workbooks.Open("C:\ab_trg.xls")  
Set oWbsh = oWb.Sheets(1)  
n = oWbsh.Cells(oWbsh.Rows.Count, 1).End(xlUp).Row  
MsgBox n  
DataArr = oWbsh.Range("A1:A" & n).Value 'берём исходные данные в массив  
array_city(1) = "Осташков"  
array_city(2) = "Лихославль"  
array_city(3) = "Ростов-На-Дону"  
array_city(4) = "Ростов"  
array_city(5) = "Бологое"  
kol = 0  
   For i = 2 To n ' считаем кол-во различных городов в файле  
       For j = 1 To 5  
           If InStr(1, DataArr(i, 1), array_city(j), vbTextCompare) = 1 Then  
               kol = kol + 1 'считаю количество городов в новом массиве  
               ReDim Preserve array_city1(UBound(array_city1) + 1) 'увеличиваем массив, нулевой элемент останется пустым  
               array_city1(kol) = array_city(j) 'формирую масссив из названий городов найденных в таблице  
               MsgBox array_city(j)  
               Exit For 'если город найден в строке, то нет необходимости проверять дальше все города, поетому выходим из цикла по j и переходим к следующей строке и уже для нее опять проверяем города  
           End If  
       Next j  
   Next i  
MsgBox kol  
For i = 1 To kol  
'здесь нужно созать новый файл куда будем записывать все строки в которых есть i-город  
For j = 2 To n  
If InStr(1, DataArr(j, 1), array_city1(i), vbTextCompare) = 1 Then  
MsgBox DataArr(j, 1) & "->" & array_city1(i) 'запись всей строки j-ой (она состоит из 10 столбцов) в созданный файл  
DataArr(j, 1) = Empty 'очищаем найденный город  
End If  
Next j  
'здесь нужно сохранить созданный и уже сформированный файл  
Next i  
oWb.Close 0 'закрываем файл без сохранения, это уже не обязательно, т.к. он не испорчен  
End Sub  
 
Теперь и отбирает корректно, и файл не портит, его можно в конце не закрывать.  
Осталось добавить запись в файл вместо MsgBox DataArr(j, 1) & "->" & array_city1(i).  
Ну и список городов нужно вероятно делать иначе, если их количество не в пределах десятка.  
Сделать список на листе, считать города в массив с листа. Код в таком случае переделывать нужно минимально -  
добавить определение этого диапазона, считывание в массив, и тогда обращение к массиву будет такое:  
array_city(j,1)  
Да, я там выше слегка запутался в этих массивах - последний цикл не по тому массиву городов сделал... :)
 
 
 
#28
23.05.2011 12:16:49
Вот набросал , добавить только создание книги, но принцип думаю поймеш  
 
 
Sub create_city_file()  
Dim cn As ADODB.Connection, rs As ADODB.Recordset  
Dim sCon As String  
Set cn = New ADODB.Connection  
Set rs = New ADODB.Recordset  
 sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName _  
 & ";Extended Properties=""Excel 8.0;HDR=No"";"  
   cn.Open sCon  
If Not cn.State = 1 Then Exit Sub  
'F1,F2 (Столбцы А и В, можно увеличить по необходимости через запятую, From диапазон данных, Лист1 имя листа  
sSql = "SELECT F1, F2  " _  
    & " FROM [Лист1$A1:B5] "
     rs.Open sSql, cn, adOpenStatic, adLockReadOnly  
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  
     a = [g1:g4].Value 'массив нужных городов может быть где угодно
'___________________________________  
For i = 1 To UBound(a)  
rs.Filter = "F1 Like '*" & a(i, 1) & "*' " 'Фильтр по первому столбцу (F1 - A)  
If rs.RecordCount > 0 Then ' если записи есть то переходим к формированию книги  
'Формируем книгу и вставляем данные примерно таким способом  
Cells(1, 1).CopyFromRecordset rs  
'сохраняем и закрываем книгу  
End If  
rs.Filter = "" ' очищаем фильтр  
Next  
       
rs.Close: cn.Close  
Set cn = Nothing: Set rs = Nothing  
End Sub
Спасибо
 
 
 
#29
23.05.2011 12:49:06
Создание книги можно тут взять, я тоже доделал :)  
 
Сделал копирование 3-х колонок, переделайте на 10.  
Там ещё порядок циклов по городам и листу был перепутан, изменил.  
И отключил обновление экрана.  
Файлы сохраняются в корень "C:\"  
 
 
Private Sub CommandButton4_Click()  
Dim i As Long, n As Long, j As Long, kol As Long, x As Long 'лучше as long, чтоб наверняка хватило, тем более что всё равно экономии памяти нет...  
Dim array_city(1 To 5) As String  
ReDim array_city1(0) As String  
Dim DataArr()  
Dim oWb As Workbook, oWbsh As Worksheet  
 
array_city(1) = "Осташков"  
array_city(2) = "Лихославль"  
array_city(3) = "Ростов-На-Дону"  
array_city(4) = "Ростов"  
array_city(5) = "Бологое"  
kol = 0  
Application.ScreenUpdating = False  
 
Set oWb = Workbooks.Open("C:\ab_trg.xls")  
Set oWbsh = oWb.Sheets(1)  
n = oWbsh.Cells(oWbsh.Rows.Count, 1).End(xlUp).Row  
'MsgBox n  
DataArr = oWbsh.Range("A1:J" & n).Value 'берём исходные данные в массив  
oWb.Close 0 'закрываем файл без сохранения, он уже не нужен  
 
   For j = 1 To 5  
   For i = 2 To n ' считаем кол-во различных городов в файле  
           If InStr(1, DataArr(i, 1), array_city(j), vbTextCompare) = 1 Then  
               kol = kol + 1 'считаю количество городов в новом массиве  
               ReDim Preserve array_city1(UBound(array_city1) + 1) 'увеличиваем массив, нулевой элемент останется пустым  
               array_city1(kol) = array_city(j) 'формирую масссив из названий городов найденных в таблице  
'                MsgBox array_city(j)  
               Exit For 'если город найден в строке, то нет необходимости проверять дальше все города, поетому выходим из цикла по j и переходим к следующей строке и уже для нее опять проверяем города  
           End If  
       Next i  
   Next j  
'MsgBox kol  
For i = 1 To kol  
'здесь нужно созать новый файл куда будем записывать все строки в которых есть i-город  
With Workbooks.Add  
With .Sheets(1)  
x = 0 'сбрасываем счётчик найденных строк  
For j = 2 To n  
If InStr(1, DataArr(j, 1), array_city1(i), vbTextCompare) = 1 Then  
'запись всей строки j-ой (она состоит из 10 столбцов) в созданный файл  
x = x + 1 'увеличиваем счётчик найденных строк  
'здесь перекладываем из массива на лист, _  
можно тоже в цикле сделать, можно сперва в _  
другой массив собрать, потом его сразу весь _  
выгрузить - так будет быстрее  
.Cells(x, 1) = DataArr(j, 1)  
.Cells(x, 2) = DataArr(j, 2)  
.Cells(x, 3) = DataArr(j, 3)  
DataArr(j, 1) = Empty 'очищаем найденный город, чтобы повторно эту строку не копировать  
End If  
Next j  
End With 'закончили с листом  
'здесь нужно сохранить созданный и уже сформированный файл  
.SaveAs Filename:="C:\" & array_city1(i) 'сохранили  
.Close 0 'закрыли  
End With 'закончили с книгой  
Next i  
Application.ScreenUpdating = True  
End Sub
 
 
 
#30
23.05.2011 14:05:09
{quote}{login=Hugo}{date=23.05.2011 12:49}{thema=}{post}Создание книги можно тут взять, я тоже доделал :)  
 
Сделал копирование 3-х колонок, переделайте на 10.  
Там ещё порядок циклов по городам и листу был перепутан, изменил.  
И отключил обновление экрана.  
Файлы сохраняются в корень "C:\"  
 
 
Private Sub CommandButton4_Click()  
Dim i As Long, n As Long, j As Long, kol As Long, x As Long 'лучше as long, чтоб наверняка хватило, тем более что всё равно экономии памяти нет...  
Dim array_city(1 To 5) As String  
ReDim array_city1(0) As String  
Dim DataArr()  
Dim oWb As Workbook, oWbsh As Worksheet  
 
array_city(1) = "Осташков"  
array_city(2) = "Лихославль"  
array_city(3) = "Ростов-На-Дону"  
array_city(4) = "Ростов"  
array_city(5) = "Бологое"  
kol = 0  
Application.ScreenUpdating = False  
 
Set oWb = Workbooks.Open("C:\ab_trg.xls")  
Set oWbsh = oWb.Sheets(1)  
n = oWbsh.Cells(oWbsh.Rows.Count, 1).End(xlUp).Row  
'MsgBox n  
DataArr = oWbsh.Range("A1:J" & n).Value 'берём исходные данные в массив  
oWb.Close 0 'закрываем файл без сохранения, он уже не нужен  
 
   For j = 1 To 5  
   For i = 2 To n ' считаем кол-во различных городов в файле  
           If InStr(1, DataArr(i, 1), array_city(j), vbTextCompare) = 1 Then  
               kol = kol + 1 'считаю количество городов в новом массиве  
               ReDim Preserve array_city1(UBound(array_city1) + 1) 'увеличиваем массив, нулевой элемент останется пустым  
               array_city1(kol) = array_city(j) 'формирую масссив из названий городов найденных в таблице  
'                MsgBox array_city(j)  
               Exit For 'если город найден в строке, то нет необходимости проверять дальше все города, поетому выходим из цикла по j и переходим к следующей строке и уже для нее опять проверяем города  
           End If  
       Next i  
   Next j  
'MsgBox kol  
For i = 1 To kol  
'здесь нужно созать новый файл куда будем записывать все строки в которых есть i-город  
With Workbooks.Add  
With .Sheets(1)  
x = 0 'сбрасываем счётчик найденных строк  
For j = 2 To n  
If InStr(1, DataArr(j, 1), array_city1(i), vbTextCompare) = 1 Then  
'запись всей строки j-ой (она состоит из 10 столбцов) в созданный файл  
x = x + 1 'увеличиваем счётчик найденных строк  
'здесь перекладываем из массива на лист, _  
можно тоже в цикле сделать, можно сперва в _  
другой массив собрать, потом его сразу весь _  
выгрузить - так будет быстрее  
.Cells(x, 1) = DataArr(j, 1)  
.Cells(x, 2) = DataArr(j, 2)  
.Cells(x, 3) = DataArr(j, 3)  
DataArr(j, 1) = Empty 'очищаем найденный город, чтобы повторно эту строку не копировать  
End If  
Next j  
End With 'закончили с листом  
'здесь нужно сохранить созданный и уже сформированный файл  
.SaveAs Filename:="C:\" & array_city1(i) 'сохранили  
.Close 0 'закрыли  
End With 'закончили с книгой  
Next i  
Application.ScreenUpdating = True  
End Sub{/post}{/quote}  
 
 
вроде пеерделала, но выдает  ошибку 1004 на строчке    
DataArr = oWbsh.Range("A1:J" & n).Value
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх