Формирование массива по условию и его запись на другой лист

[Serg1971]

Добрый день!

Если не трудно, подскажите похожий готовый пример для решения задачи с помощью макроса. Можно частями - похожий блок формирования массива, похожий блок разноски.

Ежедневно в базу заносятся номера счетов-фактур. Даты оплат могут идти непоследовательно. После оплаты этих счетов необходимо на другом листе получить разноску этих счетов в разрезе кодов оплат (Code) и организаций (Org) за указанную дату (вводится при вызове макроса).

Решение путем внедрения в ячейки функции СУММЕСЛИ не подходит - таблица большая, сильно тормозит. В примере приведен прототип натуральной базы.

С уважением, Сергей

[Hugo121]

Можно использовать словарь в словаре.
Первый - для Code, в нём словарь с ключами Org|Date, в котором собираем суммы.
Ну и для выгрузки ещё можно собрать коллекцию (или тоже словарь) всех встреченных дат, если нет уже готового списка.

[Hugo121]

Вот на скору руку, без вывода на лист - результат в окне отладки:

Option Explicit

Sub tt() ' словарь в словаре
    Dim a, i&, t$, Dic As Object, Dic2 As Object
    Dim el, col
    
    With Sheets(1)
    a = .Range("D2", .Cells(.Rows.Count, "A").End(xlUp)).Value
    End With
    
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .CompareMode = 1
        For i = 1 To UBound(a)
            t = a(i, 3)
            If Not .exists(t) Then .Add t, CreateObject("Scripting.Dictionary")
            .Item(t).Item(a(i, 1) & "|" & a(i, 4)) = .Item(t).Item(a(i, 1) & "|" & a(i, 4)) + a(i, 2)
        Next
    End With
    
    For Each el In Dic.keys
        Debug.Print "Code " & el
        Set Dic2 = Dic.Item(el)
        For Each col In Dic2.keys
            Debug.Print "Org|Date " & col & "|" & Dic2.Item(col)
        Next
        Debug.Print "Закрываем группу " & el
    Next

End Sub

[Serg1971]

Hugo, спасибо. Уважаю профессионалов. Это явно не мой уровень. Для меня "словарь в словаре" - контрольный в голову. Я не хотел, чтобы кто-то писал для меня новый код. Думал, у кого-то есть готовые похожие примеры но с кодом попроще, чтобы я сам смог собрать Лего в кучу.

[Hugo121]

А я и не писал новый. Я взял свой старый

Sub PereborFailov2() ' словарь в словаре
    Dim a, i&, t$, Dic As Object, Dic2 As Object
    Dim el, col
    
    a = Range("C3", Cells(Rows.Count, "A").End(xlUp)).Value
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .CompareMode = 1
        For i = 1 To UBound(a)
            t = a(i, 1)
            If Not .exists(t) Then .Add t, CreateObject("Scripting.Dictionary")
            .Item(t).Item(a(i, 2) & "|" & a(i, 3) & "|" & i) = 0&
            
        Next
    End With
    
    For Each el In Dic.keys
        Debug.Print "Открываем файл " & el
        Set Dic2 = Dic.Item(el)
        For Each col In Dic2.keys
            Debug.Print "Ищем данные " & col '& "|" & Dic2.Item(col)
        Next
        Debug.Print "Закрываем файл " & el
    Next

End Sub

[Serg1971]

После контрольного в голову произошла реинкарнация Мой опыт программирования прервался лет 15 назад (базы данных) на обработке массивов. Сейчас немного "курнул" матчасти и понял суть словарей. Тем более словарей в словарях. Хотя с современным синтаксисом туговато. Сам бы такого кода не написал сразу. Но с помощью приведенного примера первая часть задачи решилась. За определенную дату формируется нужный массив.
Дальше вижу такую схему:
1) отсортировать словарь Dic2 в алфавитном порядке по организациям и готовый результат выгрузить в новый словарь, так как на закладке Rep организации выстроены строго по алфавиту в разрезе каждого кода
2) в цикле ищем точку пересечения Введенной даты и i-того кода (Code)- ячейка с красным цветом и увеличиваем номер строки на 1 после каждого элемента из Dic2
3) в указанные координаты выгружаем элемент словаря Dic2

Может быть я ошибаюсь с методикой решения задачи, поэтому, пожалуйста, подскажите свой вариант. Если с кодом возиться трудно - хотя бы структурное решение.

В итоге в ячейках зеленого цвета на закладке Rep должны появиться нужные суммы.


С уважением, Сергей.

Option Explicit

Sub tt()
Dim a, i&, t$, Dic As Object, Dic2 As Object
Dim el, col
Dim What As Date

With Sheets(1)
a = .Range("D2", .Cells(.Rows.Count, "A").End(xlUp)).Value
End With

What = InputBox("Input date", , "21.08.2016")

Set Dic = CreateObject("Scripting.Dictionary" )
With Dic
.CompareMode = 1
For i = 1 To UBound(a)
If What = a(i, 4) Then
t = a(i, 3)
If Not .exists(t) Then .Add t, CreateObject("Scripting.Dictionary" )
.Item(t).Item(a(i, 1) & "|" & a(i, 4)) = .Item(t).Item(a(i, 1) & "|" & a(i, 4)) + a(i, 2)
End If
Next
End With

For Each el In Dic.keys
Debug.Print "Code " & el
Set Dic2 = Dic.Item(el)
For Each col In Dic2.keys
Debug.Print "Org|Date " & col & "|" & Dic2.Item(col)
Next
Debug.Print "Close group " & el
Next

End Sub

[Hugo121]

Словари не сортируются. Вообще Microsoft даже не гарантирует порядок расположения ключей в словаре.
Но вот выгрузить ключи в массив и отсортировать их можно, а уже затем брать из этого массива ключ и искать в словаре.
Ну или можно использовать "словарь" из .Net, или даже вот так:

    Set Result = CreateObject("System.Collections.ArrayList")
    Result.AddRange Dict.Keys
    Result.Sort
    Unique = Application.WorksheetFunction.Transpose(Result.ToArray)

Далее вникать сейчас некогда, убегаю. Домой.

[Hugo121]

Не вижу смысла фильтровать по датам при заполнеии словаря, ну разве если данных очень много и не хочется нагружать словарь/память лишним.
Ну а с выгрузкой собранного просто - два цикла - один внешний по датам - второй внутренний по названиям - или наоборот - получаем ключ, из словаря берём по ключу сумму - пишем на пересечении.
Если сразу нет готовой формы с датами и названиями - из собираем на первом этапе:

Сообщение от Hugo121

Ну и для выгрузки ещё можно собрать коллекцию (или тоже словарь) всех встреченных дат, если нет уже готового списка.

На втором этапе можно сперва создать массив по собранному (даты можно сперва отсортировать, если они собрались вперемешку), затем цикл в цикле и заполнение.
Или можно совместить например внешний цикл с заполнением шапки сводной.

[Serg1971]

Разноска выполняется в режиме реального времени за ОДНУ определенную дату - введенную вначале. На закладке Rep существует готовая форма с датами , кодами платежей и названиями организаций. Проблема (для меня) написать выражение VBA для поиска точки пересечения введенной даты и первого кода из словаря. В примере - ячейка красного цвета. Думаю, дальше от этой ячейки я смогу оттолкнуться.

С уважением, Сергей.

[Hugo121]

В примере нет ничего красного.
Ну если нужна только одна дата - тогда да, можно и отбрасывать все другие.
"Первый код из словаря" - что за код?
Ну а пересечение даты и названия получаем так - цикл во первой строке, в нём цикл по первому столбцу - получаем cells(x,y)