Страницы: 1
RSS
Заполнение таблицы данными из нескольких файлов
 
Добрый день!
Столкнулся со следующей задачей.
Необходимо заполнить файл (отчет.xls) данными из нескольких книг типа (Альфа [2015.04.09 23-23'03''];).
Отчет представляет из себя предварительно заполненный файл, много столбцов, около 1000 строк.
Это прогноз отгрузок по кодам продукции-по регионам-по дистрибюторам с разбивкой по месяцам.

Альфа [2015.04.09 23-23'03''] - пример файла прогноза по 1 дистрибютору по 1 региону.
Как я это делал.
1) Объединял все файлы типа Альфа [2015.04.09 23-23'03''] в одну длинную таблицу
2) добавлял столбец, в который "сцеплял" значения ячеек КодСтранаДистрибютор
3) добавлял столбец в файл "Отчет" в котором так же сцеплял значения ячеек КодСтранаДистрибютор
4) в таблице "Отчет"  начиная с ячейки BM6-BV6 ВПРил данные из первой таблицы.

Хочу автоматизировать этот процесс, как сделать это оптимальнее?
Karim
 
Можно сделать на SQL запросе, если структура таблиц не меняется часто.
Неизлечимых болезней нет, есть неизлечимые люди.
 
Можно делать на словаре - сперва в цикле открываем все источники и заполняем словарь данными, ключ Код|Страна|Дистрибютор|дата, затем выгружаем собранное из словаря в отчёт.
Тут манёвр больше чем с SQL.
 
Цитата
Hugo написал: Можно делать на словаре
Спасибо за подсказку, не совсем понял как это реализовать.
Из "двухмерной" таблицы сделать линейную, и затем раскидывать данные обратно в двухмерную?

не могли бы пример со словарем привести?
Karim
 
Делал уже похожее, но сейчас не найду, а писать времени нет.
Но идея такая - открыли в цикле файлы, в каждом цикл в цикле по столбцам и строкам - составляем ключ, из пересечения берём значение, запоминаем в словаре.
В финале аналогично цикл в цикле по столбцам и строкам отчёта - составляем ключ, берём по нему значение из словаря, кладём в пересечение столбца и строки.
 
Файлы должен находится в папке C:\1\
На таблице правой кнопкой мыши - Обновить.
Неизлечимых болезней нет, есть неизлечимые люди.
 
Спасибо,
Оригинальный вариант, но не совсем подходит для моей задачи, тк нет возможности вписать (обновить) в уже имеющуюся таблицу.

Цитата
Hugo написал: Делал уже похожее, но сейчас не найду, а писать времени нет.
Если найдется нужный файл, буду рад примеру.
Karim
 
Сделал как выше описывал.
 
Цитата
К М написал: ... тк нет возможности вписать (обновить) в уже имеющуюся таблицу
Не совсем понятно, почему нет возможности!? Копируете таблицу в нужный вам файл и в подключении, в свойствах указываете те файлы, которые у вас являются источниками. если источников больше двух, то в SQL строке добавляете блоки UNION (прямо копируете) с изменением имени источника.
Неизлечимых болезней нет, есть неизлечимые люди.
 
Цитата
Hugo написал: Сделал как выше описывал.
Спасибо, осталось разобраться как это работает.
Нашел описание метода Scripting Dictionary http://www.osp.ru/win2000/2006/07/3643019/

Может посоветуете еще что ни будь на эту тему?
Karim
 
http://www.script-coding.com/WSH/Dictionary.html
 
Цитата
К М написал: не совсем подходит для моей задачи, тк нет возможности вписать (обновить) в уже имеющуюся таблицу
вписать в исходники... и (в самом запросе дописать столбцы если надо)... и обновить запрос... или всё то же самое, предложенное запросом, в переводе на vba (с выбором файлов)... собирает все выбранные файлы... и... запрос удаляет :oops: ... обновление по новому запуску макроса 8) ... запрос из поста№6... выгрузка на Лист4 - или исправить по коду...
P.S. для различного кол-ва файлов должен работать...
Скрытый текст
для тех, кто не любит запросы или их фоновое обновление - которое почему-то только принудительно закрывается при выходе из Windows...:cry:... если его всё-таки оставлять фоновым
Скрытый текст
Изменено: JeyCi - 19.04.2015 11:19:41
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
вот и сам запрос по коду #12 вроде бы похорошел, если выразиться правильным синтаксисом (или очень похожим на правильный):
Код
rSQL = "SELECT ALL *" _
& " FROM """ & SpisokFailov(1) & """.[Output$] [Output$]"
For i = 2 To SpisokFailov.Count
    sSQL = rSQL & " UNION " _
    & " SELECT ALL *" _
    & " FROM """ & SpisokFailov(i) & """.[Output$] [Output$]"
    rSQL = Empty
Next i
sSQL = sSQL & " ORDER BY 3;"
p.s. насколько поняла, ТС хотел выбрать всё из файлов-исходников - ALL <столбцы>
P.P.S с n-го кол-ва раз всё-таки запостила всё (спойлер прыгает)
-  в пост#12 на месте запроса внести #13 - и работает - проверила ещё раз
Изменено: JeyCi - 15.04.2015 13:38:13
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Добрый день!
Вопрос по поводу кода от Hugo, из №5 поста

Что имеется ввиду "If A(i, ii) > 0 Then 'если есть значение (можно это условие убрать, зависит от задачи)"

Исходная таблица немного изменилась, начали добавляться новые столбцы в конце,
как изменить работу макроса на заполнение данными новых колонок?

судя по коду за это отвечают:
           b = .[a4].CurrentRegion.Columns(5).Resize(, 20).Value
и
               .[a5].CurrentRegion.Columns(5).Resize(, 20).Value = b

так ли это?

Код
Sub Load_data_from_archive()

    Dim vFile, A(), b(), d As Object, wb As Object, i&, ii&, t$

        Set d = CreateObject("scripting.dictionary"): d.comparemode = 1

                Set wb = ActiveWorkbook
                
                A = wb.Sheets(tName).[A1].CurrentRegion.Value
                For i = 2 To UBound(A)
                    For ii = 4 To UBound(A, 2)
                        If A(i, ii) > 0 Then 'если есть значение (можно это условие убрать, зависит от задачи)
                            t = A(i, 1) & "|" & A(i, 2) & "|" & A(i, 3) & "|" & Format(A(1, ii), "dd.mm.yyyy")
                            d.Item(t) = A(i, ii)
                        End If
                    Next ii, i
                   ' wb.Close 0
                'End If


        With ThisWorkbook.Sheets("Main")
            A = .[a4].CurrentRegion.Columns(1).Resize(, 4).Value
            b = .[a4].CurrentRegion.Columns(5).Resize(, 20).Value
            For i = 2 To UBound(A)
                For ii = 1 To UBound(b, 2)
                    t = A(i, 1) & "|" & A(i, 2) & "|" & A(i, 3) & "|" & Format(b(1, ii), "dd.mm.yyyy")
                    If d.exists(t) Then b(i, ii) = d.Item(t)
                Next ii, i

                .[a5].CurrentRegion.Columns(5).Resize(, 20).Value = b
            End With


        End Sub

Всех с наступающими праздниками и выходными
ps при копировании из/в vba возникают проблемы с кодировкой, как бороться?
Karim
 
Цитата
K M написал: при копировании из/в vba возникают проблемы с кодировкой, как бороться?
Копировать при русской раскладке клавиатуры.
 
Цитата
K M написал: Что имеется ввиду "If A(i, ii) > 0 Then 'если есть значение
То и и имеется - если в ячейке есть значение, то есть смысл собирать пременную t и записывать это значение в словарь. Зачем зря работать, если его нет?
С другой стороны - если занесём пустое, то затем этим пустым затрём ячейку в сводной таблице. Если не занесём - ничего не затрём.
Т.е. зависит от задачи - нужно собирать изменяющиеся данные в  сводную, или нужно один раз обновить все данные (или собрать один раз).

И да - Columns(5).Resize(, 20) означает что в массив берётся 20 столбцов заполненной области указанной ячейки, начиная с пятого.
Можно этот диапазон определить как угодно, смотря по данным/задаче.
Изменено: Hugo - 08.05.2015 18:06:23
 
Спасибо!
Karim
Страницы: 1
Наверх