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

[Serg1971]

Извиняюсь, не залил новый файл. Хотел сразу с уже готовым макросом, но форум не поддерживает расширение .xlsm . В цикле из словаря Dic нужно взять код платежа (например первый код - А-01) и найти точку пересечения с введенной датой (21.08.2016) - ячейка с красным цветом. Помогите правильно составить выражение для поиска этой ячейки (по двум условиям - коду платежа и дате). Например, для упрощения, в красную ячейку выгрузить первый код платежа из Dic ( в данном случае А-01).

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

[IgorGO]

форум поддерживает расширения .rar .zip и др.

[Hugo121]

Если нужно найти эту красную ячейку - перебором или поиском находим столбец с нужной датой, затем перебором или поиском находим строку с кодом, и никакие словари тут не нужны, т.к. нет в словаре никаких данных именно для этой ячейки.
Ну а для других, которые ниже по столбцу данные есть, но Вам они я так понимаю по вопросу не нужны?
Далее - Вы пишите "с введенной датой (21.08.2016)" - куда когда и кем введённой?
В общем я пока не понимаю что и как нужно делать, догадки есть, но кому нужны догадки... Мне не нужны.

[Serg1971]

IgorGo
Понял.

Hugo121
Я писал вначале, что за определенный день оператор делает разноску оплаченных счетов в разрезе кодов платежей и организаций (пока что вручную). Для автоматизации процесса необходимо создать макрос и на старте ввести нужную дату через InputBox - обычно за предыдущий день.
Я так понимаю, что на форуме задается много вопросов от таких "чайников", как я. Поэтому трудно держать в голове - у кого машины стают под загрузку в екселе, у кого налоги с зарплаты неправильно считаются, у кого (как у меня) вводится какая -то дата и т.п.
Большое спасибо и за первую часть кода. Остальное доделаю сам, просто уйдет больше времени, а хотелось поскорее помочь сотруднику.
Еще раз спасибо!
По этой теме больше тревожить не буду.

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

[Hugo121]

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

[Serg1971]

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

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

P.S. Для понимания остальным юзерам суть задачи такова: каждый день в систему заносятся счета на оплату разным контрагентам в разрезе НЕСКОЛЬКИХ СВОИХ организаций (Организация). После оплаты указанных платежей за каждый день (дата вводится с клавиатуры) формируется разноска этих платежей по соответствующим кодам. В результате за весь календарный год на закладке Rep формируется платежный календарь.

[Hugo121]

Так выгрузка будет пулей, и могут быть одинаковые первые буквы в разных ключах!

Option Explicit

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

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

    What = InputBox("Введите дату оплаты?", , "21.08.2016")

    'Определяем номер колонки (n_column) на закладке Rep для разноски за опреденную дату'
    For n_column = 1 To 400
        If Worksheets(2).Cells(1, n_column) = What Then Exit For
    Next n_column
    'MsgBox n_column'


    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

    With Sheets(2)
        a = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Value
        t = ""
        For i = 1 To UBound(a)
            If Dic.exists(a(i, 1)) Then t = a(i, 1)
            If Len(t) Then
                If Dic(t).exists(a(i, 1) & "|" & What) Then a(i, 1) = Dic(t).Item(a(i, 1) & "|" & What) Else a(i, 1) = Empty
            Else
                a(i, 1) = Empty
            End If
        Next
        .Cells(2, n_column).Resize(UBound(a), 1) = a
    End With

End Sub

[Serg1971]

Пуля - то что надо. Хотя трехсекундная обработка предыдущего варианта меня тоже устраивала - успевал вздремнуть

По ходу дела напрашивается следующий вопрос (поиском не нашел конкретного ответа). По некоторым соображениям нерационально хранить макрос в рабочей базе. Хотелось бы, чтобы этот код хранился в другом файле ???.xlsm и из него запускался макрос по обработке рабочей открытой базы Acc.xlsx. Почитал про личную книгу макросов - не внушает доверия.

[Hugo121]

Чем не внушает?
Я там что-то храню, а что-то в надстройке, а что-то в спецфайлах-инструментах.
Храните где угодно, но в стандартном модуле - тогда код исправно отработает на активной в момент запуска книге.

[Serge_Bliznykov]

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

Храните где угодно, но в стандартном модуле - тогда код исправно отработает на активной в момент запуска книге.

простите, а можно уточнить - а что означает "в стандартном модуле"?
а можно хранить не в стандартном? А это как?
я не очень силён в терминологии, поясните, пожалуйста, что Вы под этим подразумевали.