Страницы: 1
RSS
Копирование данных из XLS в TXT
 
Добрый день!  
Помогите пожалуйста с макросом. Есть таблица: первый столбец - магазины, второй - артикулы для этих магазинов.  
Необходимо:  
1. создать TXT-файлы, имена которых будут соответствовать названиям магазинов из первого столбца.  
2. скопировать данные из второго столбца (артикулы) по текстовым файлам, в соответствии с принадлежностью тому или иному магазину.  
Во вложении пример исходной таблицы.
 
искать готовое решение не пробовали?  
такие темы раз в неделю всплывают...  
 
вот готовый макрос, только пару букв поменять:  
http://programmersforum.ru/showthread.php?t=179047
 
Я думаю, там сперва нужно набрать в словарь магазины, а каждому магазину в  Item через Redim Preserve набрать в массив артикулы (ну или сразу создать массив по максимуму и при выгрузке взять только заполненную часть).  
Потом перебрать словарь и каждому уникальному создать файл, в который выгрузить массив данных.  
Код писать некогда... Все части кода были на форуме - сохранение в файл по ссылке EducatedFool можно взять и чуть доработать.
 
Готовое решение конечно пробовал найти, но безуспешно. Похожие темы были, но как то объединить всю информацию из них и подстроить под свой пример не получается, ввиду своей неопытности в VBA.  
Пример по ссылке от EducatedFool не совсем подходит. Исходная таблица там отличается от моей (одной ячейке из столбца A соответствует только одна ячейка из столбца B; в моем же варианте в столбце A может быть несколько одинаковых записей, которым соответствует диапазон ячеек из столбца B, который в свою очередь и нужно скопировать в текстовый файл, имя которого должно соответсвовать данным из столбца A).  
Понимаю что готовый код писать никто не будет)), но если не трудно, киньте еще пару-тройку ссылок на подобные темы, буду сам ковыряться)  
Заранее спасибо.
 
Поискать, и выложить сюда ссылки?
 
Предыдущий пост мой - не залогинился.
 
Массивы в словаре: http://www.planetaexcel.ru/forum.php?thread_id=31394 <BR>Немного переделать наполнение словаря под задачу, полностью переделать выгрузку на запись в тхт.
 
Sub GetTXTfile()  
Dim cn As ADODB.Connection, rs As ADODB.Recordset, rs2 As ADODB.Recordset  
Dim sCon$, StrSql$, i&  
Set cn = New ADODB.Connection  
Set rs = New ADODB.Recordset  
Set rs2 = New ADODB.Recordset  
sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName _  
& ";Extended Properties=""Excel 8.0;IMEX=1;HDR=No"";"  
cn.Open sCon  
If Not cn.State = 1 Then Exit Sub  
StrSql = "Select F1 from [Лист1$]group by F1"
rs.Open StrSql, cn, adOpenKeyset, adLockPessimistic  
For i = 0 To rs.RecordCount - 1  
StrSql = "select F2 from [Лист1$] where F1='" & rs.Fields(0).Value & "'"
 
rs2.Open StrSql, cn, adOpenKeyset, adLockPessimistic  
Open ThisWorkbook.Path & "\" & rs.Fields(0).Value & ".txt" For Output As #1  
Print #1, rs2.GetString(adClipString, -1, ";", vbCrLf, "(NULL)")  
rs2.Close  
Close  
rs.MoveNext  
Next  
rs.Close:  cn.Close  
Set cn = Nothing: Set rs = Nothing  
End Sub  
 
Библиотека ADO должна быть подкоючена, файлы сохраняются в той же папке что и файл xls.
Спасибо
 
R Dmitry - огромное спасибо!!!  
То что и требовалось) правда в коде с ADO ничего не понятно, но зато работает))) буду разбираться.  
Еще раз всем СПАСИБО за участие.
 
Я предпочитаю словари и массивы - там как хочешь, так данные и крутишь.  
А с этим ADO и впрямь ничего не понять... :)
 
Ну не знаю, мне все понятно, доступно и просто :)
Спасибо
 
Hugo, суть использования словарей и массивов в моем случае я понял, но чисто теоретически... Вот как это на практике осуществить? VBA я только только начал осваивать, поэтому было бы здорово на реально работающем коде разбираться. Если есть время и желание, скиньте пожалуйста ваш вариант. Очень хочется до конца разобраться...
 
Работающий код файле в теме по ссылке (ну или вернее там и файл, и код).  
Там в принципе задача одинаковая с Вашей, но выгрузка всего происходит на один лист в соседние столбцы.
 
И кстати, мой код Sub Otbor() без переделок (вообще ничего не менял) отработал верно на Вашем файле :)
 
Да, я проверял, Ваш код работает. Но мне нужно чтобы выгрузка из словаря происходила именно в txt. С этим загвоздка.
 
Так тут уже два примера записи в тхт было.  
Возьмём за образец последний:  
 
       For Each kk In oDict.keys  
           b = oDict.Item(kk)  
           Open ThisWorkbook.Path & "\" & b(1, 1) & ".txt" For Output As #1  
           For i = 2 To b(UBound(b), 1)  
               Print #1, b(i, 1)  
           Next  
           Close #1  
       Next  
 
 
Поясню - в b(UBound(b), 1) лежит количество заполненных строк, а в первой строке ненужное название магазина.
 
Только учтите, что в названиях магазинов не должно быть символов, недопустимых в названии файла - иначе будет ошибка.  
Ну или перед выгрузкой все такие символы нужно удалить или заменить.  
Или перед анализом названий...
Страницы: 1
Читают тему
Наверх
Loading...