Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 20.11.2017, 14:38   #1
dianamiss
Новичок
Джуниор
 
Регистрация: 20.11.2017
Сообщений: 3
По умолчанию Сборка из плоских файлов в отчет

Всем привет, мне нужно консолидировать реестры с разных листов в один сводный отчет в отдельном листе.

Реестры в виде плоских файлов: тоесть каждая операция разбивается на число строк равное числу позиции товаров/услуг.

Пример - одна реализация состоящая из 3х товаров и 1ой услуге, бъется на 4 строки.
Сама прописала только формулами, в основном СУММЕСЛИМН

Просьба помочь с кодом,если будет у вас время.Очень выручите.

Пример приложила
Вложения
Тип файла: xls primerr.xls (71.5 Кб, 18 просмотров)
dianamiss вне форума Ответить с цитированием
Старый 20.11.2017, 15:34   #2
dianamiss
Новичок
Джуниор
 
Регистрация: 20.11.2017
Сообщений: 3
По умолчанию

В каждом листе может присутствовать до 10000строк
dianamiss вне форума Ответить с цитированием
Старый 20.11.2017, 20:30   #3
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Сработает такой алгоритм - делаем словарь заказов, с массивом данных по каждому заказу.
Или 11 словарей
Сперва циклом по листам с данными собираем всё в словарь/и, затем в финале циклом по словарю/ям заполняем сводную.
Писать код неинтересно/хлопотно, слишком много рутины.
В принципе тут на форуме много готовых кодов с Scripting.Dictionary, можно брать и приспосабливать любой.

P.S. Посмотрел пристальнее - 7 словарей достаточно.

Сделал.
Там на листе желательно сперва всем датам задать одинаковый формат, там кое-где даты текстом (хотя на работу кода это не влияет).
Ну и с форматом вывода ничего не делал - можете или дописать в код, или навесить на лист вручную.
Код:
Option Explicit

Sub tt()
    Dim a, i&, t$, k
    Dim DicSklad As Object
    Dim DicKlient As Object
    Dim DicData As Object
    Dim DicZak As Object
    Dim DicRealiz1 As Object
    Dim DicRealiz2 As Object
    Dim DicPostup As Object

    Set DicSklad = CreateObject("Scripting.Dictionary"): DicSklad.comparemode = 1
    Set DicKlient = CreateObject("Scripting.Dictionary"): DicKlient.comparemode = 1
    Set DicData = CreateObject("Scripting.Dictionary"): DicData.comparemode = 1
    Set DicZak = CreateObject("Scripting.Dictionary"): DicZak.comparemode = 1
    Set DicRealiz1 = CreateObject("Scripting.Dictionary"): DicRealiz1.comparemode = 1
    Set DicRealiz2 = CreateObject("Scripting.Dictionary"): DicRealiz2.comparemode = 1
    Set DicPostup = CreateObject("Scripting.Dictionary"): DicPostup.comparemode = 1

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    a = Sheets("Реестр реализаций").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        t = Trim(a(i, 11))
        DicSklad.Item(t) = Trim(a(i, 5))
        DicKlient.Item(t) = Trim(a(i, 10))
        DicData.Item(t) = a(i, 12)
        t = Trim(a(i, 11)) & "|" & Trim(a(i, 4))
        DicRealiz1.Item(t) = DicRealiz1.Item(t) + a(i, 7)
        DicRealiz2.Item(t) = DicRealiz2.Item(t) + a(i, 8)
    Next

    a = Sheets("Реестр заказов покупателей").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        t = Trim(a(i, 2))
        If DicSklad.Item(t) = "" Then DicSklad.Item(t) = Trim(a(i, 9))
        If DicKlient.Item(t) = "" Then DicKlient.Item(t) = Trim(a(i, 10))
        If DicData.Item(t) = "" Then DicData.Item(t) = a(i, 1)

        If Trim(DicData.Item(t)) <> Trim(a(i, 1)) Then MsgBox "Расхождение в датах на листе Реестр заказов покупателей по заказу " & t _
           & vbNewLine & DicData.Item(t) & "<>" & a(i, 1), vbCritical

        t = Trim(a(i, 2)) & "|" & Trim(a(i, 6))
        DicZak.Item(t) = DicZak.Item(t) + a(i, 8)
    Next

    a = Sheets("Реестр поступлений").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)

        t = Trim(a(i, 9))
        If DicSklad.Item(t) = "" Then DicSklad.Item(t) = Trim(a(i, 8))
        If DicKlient.Item(t) = "" Then DicKlient.Item(t) = "Покупатель"
        If DicData.Item(t) = "" Then DicData.Item(t) = a(i, 10)
        
        If Trim(DicData.Item(t)) <> Trim(a(i, 10)) Then MsgBox "Расхождение в датах на листе Реестр поступлений по заказу " & t _
           & vbNewLine & DicData.Item(t) & "<>" & a(i, 10), vbCritical

        t = Trim(a(i, 9)) & "|" & Trim(a(i, 4)) & "|" & a(i, 10)
        DicPostup.Item(t) = DicPostup.Item(t) + a(i, 6)
    Next

    With Sheets("Сводная")
        i = 9    ' для сравнения с заказом, в рабочем варианте ставьте 3
        For Each k In DicSklad.keys
            i = i + 1
            .Cells(i, 2).Value = DicSklad(k)
            .Cells(i, 3).Value = DicKlient(k)
            .Cells(i, 4).Value = k
            .Cells(i, 5).Value = DicData(k)
            .Cells(i, 6).Value = DicZak(k & "|Товар")
            .Cells(i, 7).Value = DicZak(k & "|Услуга")
            .Cells(i, 8).Formula = "=" & .Cells(i, 6).Address(0, 0) & "+" & .Cells(i, 7).Address(0, 0)

            .Cells(i, 9).Value = DicRealiz1(k & "|Товар")
            .Cells(i, 10).Value = DicRealiz1(k & "|Услуга")
            .Cells(i, 11).Formula = "=" & .Cells(i, 9).Address(0, 0) & "+" & .Cells(i, 10).Address(0, 0)
            .Cells(i, 12).Value = DicRealiz2(k & "|Товар")
            .Cells(i, 13).Value = DicRealiz2(k & "|Услуга")
            .Cells(i, 14).Formula = "=" & .Cells(i, 12).Address(0, 0) & "+" & .Cells(i, 13).Address(0, 0)

            .Cells(i, 15).Value = DicPostup(k & "|Товар|" & .Cells(i, 5))
            .Cells(i, 16).Value = DicPostup(k & "|Услуга|" & .Cells(i, 5))
            .Cells(i, 17).Formula = "=" & .Cells(i, 15).Address(0, 0) & "+" & .Cells(i, 16).Address(0, 0)

        Next
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub
webmoney: E265281470651 Z422237915069 R418926282008

Последний раз редактировалось Hugo121; 20.11.2017 в 23:46.
Hugo121 вне форума Ответить с цитированием
Старый 21.11.2017, 08:18   #4
dianamiss
Новичок
Джуниор
 
Регистрация: 20.11.2017
Сообщений: 3
По умолчанию

Сделал - Большое при большое Спасибо Вам Hugo121!!! Вы сделали меня счастливой)
dianamiss вне форума Ответить с цитированием
Старый 21.11.2017, 09:39   #5
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Нашёл в коде пару лишних "операций" - там в трёх местах есть такая последовательность:
Код:
t = Trim(a(i, 11))
...
t = Trim(a(i, 11)) & "|" & Trim(a(i, 4))
Нижнюю строку можно записать так:
Код:
t = t & "|" & Trim(a(i, 4))
будет на один Trim() меньше, ускритесь может на секунду.
Вообще если заметите что работает долго - можно выгружать данные не на лист поячеечно, а создать пустой массив нужного размера (все размеры к финалу уже известны), наполнить его данными, и уже затем вывалить его на лист - будет заметно быстрее, если строк больше тысячи.
Ну и ещё можно добавить информацию о ходе работы в статусбар - это если уж точно долго работает, и хотелось бы видеть что процесс не повис.
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вычисление площадей плоских геометрических фигур методом Монте-Карло на с++ hihikalka Помощь студентам 0 26.02.2012 12:07
Сборка листов из разных файлов в один Vja4eslav Microsoft Office Excel 8 17.08.2011 16:30
Сборка и разборка файлов SlippyK Помощь студентам 2 24.02.2011 22:06
Сборка нескольких файлов в один Gamst Помощь студентам 4 02.06.2010 20:19
Пересечение плоских фигур Викдон Общие вопросы C/C++ 2 17.03.2009 08:16