Как в существующий макрос добавить еще одно условие выборки?

[ХочуЗнать]

ДОБРОГО ДНЯ ДРУЗЬЯ И ПОМОЩНИКИ!
Наверняка по следующему вопросу нужна отдельная тема.
помогите, плиз, добавить в условия выборки месяц и год. Которые также задаются выпадающими списками.

[ХочуЗнать]

Забыл за файл, простьите!

[Hugo121]

Если переделать, чтоб месяцы писались числами, то работает такой код:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a(), i&, ii&, t, m As Byte, y&
    If InStr("$C$3$E$3$F$3", Target.Address) Then
        [a6].CurrentRegion.Offset(1).Clear
        t = [c3].Value: m = [e3].Value: y = [f3].Value
        a = Sheets("База").[a2].CurrentRegion.Value
        ReDim b(1 To UBound(a), 1 To 4)
        For i = 1 To UBound(a)
            If a(i, 2) = t Then
                If Year(CDate(a(i, 1))) = y Then
                    If Month(CDate(a(i, 1))) = m Then
                        ii = ii + 1
                        b(ii, 1) = ii
                        b(ii, 2) = a(i, 1)
                        b(ii, 3) = a(i, 3)
                        b(ii, 4) = a(i, 7)
                    End If
                End If
            End If
        Next
        If ii > 0 Then [a7].Resize(ii, 4) = b
    End If
End Sub

Если не переделывать - то лениво прописывать код соответствия месяцев на русском числам
Но я бы в начале кода набрал словарь январь/1 и т.д., далее извлекал число из этого словаря.
Зачем Вам месяц именно словами?

[ХочуЗнать]

Дело в том что, если в реальном отчете в шапке будет написано, например так:
ОТЧЕТ №112
За 01 2012 года
, то єто в крайнем случае, будкт мало понятно.

[staniiislav]

так не подойдет




добавлено позже
или так:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a(), i&, ii&, t
        If Target.Address = "$C$3" Or Target.Address = "$E$3" Then
            [a6].CurrentRegion.Offset(1).Clear
            a = Sheets("Áàçà").[a2].CurrentRegion.Value
            ReDim b(1 To UBound(a), 1 To 4)
                For i = 1 To UBound(a)
                    If a(i, 2) = Cells(3, "c") And Format(a(i, 1), "MMMM YYYY") _
                        = Format(Cells(3, "e"), "MMMM YYYY") Then
                        ii = ii + 1
                        b(ii, 1) = ii
                        b(ii, 2) = a(i, 1)
                        b(ii, 3) = a(i, 3)
                        b(ii, 4) = a(i, 7)
                    End If
                Next
            If ii > 0 Then [a7].Resize(ii, 4) = b
        End If
End Sub

[staniiislav]

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

Если переделать, чтоб месяцы писались числами, то работает такой код:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a(), i&, ii&, t, m As Byte, y&
    If InStr("$C$3$E$3$F$3", Target.Address) Then
        [a6].CurrentRegion.Offset(1).Clear
        t = [c3].Value: m = [e3].Value: y = [f3].Value
        a = Sheets("База").[a2].CurrentRegion.Value
        ReDim b(1 To UBound(a), 1 To 4)
        For i = 1 To UBound(a)
            If a(i, 2) = t Then
                If Year(CDate(a(i, 1))) = y Then
                    If Month(CDate(a(i, 1))) = m Then
                        ii = ii + 1
                        b(ii, 1) = ii
                        b(ii, 2) = a(i, 1)
                        b(ii, 3) = a(i, 3)
                        b(ii, 4) = a(i, 7)
                    End If
                End If
            End If
        Next
        If ii > 0 Then [a7].Resize(ii, 4) = b
    End If
End Sub

Если не переделывать - то лениво прописывать код соответствия месяцев на русском числам
Но я бы в начале кода набрал словарь январь/1 и т.д., далее извлекал число из этого словаря.
Зачем Вам месяц именно словами?

Если не сложно, скиньте пример со словарем ))))

[Hugo121]

Уж столько было этих словарей...
Но повторение - мать учения

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a(), i&, ii&, t, m As String, y&

    If InStr("$C$3$E$3$F$3", Target.Address) Then
        [a6].CurrentRegion.Offset(1).Clear

        With CreateObject("scripting.dictionary")
            .Item("январь") = 1
            .Item("февраль") = 2
            .Item("март") = 3
            .Item("апрель") = 4
            .Item("май") = 5
            .Item("июнь") = 6

            t = [c3].Value: m = [e3].Value: y = [f3].Value
            a = Sheets("База").[a2].CurrentRegion.Value
            ReDim b(1 To UBound(a), 1 To 4)

            For i = 1 To UBound(a)
                If a(i, 2) = t Then
                    If Year(CDate(a(i, 1))) = y Then
                        If Month(CDate(a(i, 1))) = .Item(m) Then
                            ii = ii + 1
                            b(ii, 1) = ii
                            b(ii, 2) = a(i, 1)
                            b(ii, 3) = a(i, 3)
                            b(ii, 4) = a(i, 7)
                        End If
                    End If
                End If
            Next

        End With

        If ii > 0 Then [a7].Resize(ii, 4) = b
    End If
End Sub

Внимание - там в оригинале "апреь"!
Я исправил у себя и на листе, и в коде

[staniiislav]

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

Уж столько было этих словарей...
Но повторение - мать учения

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a(), i&, ii&, t, m As String, y&

    If InStr("$C$3$E$3$F$3", Target.Address) Then
        [a6].CurrentRegion.Offset(1).Clear

        With CreateObject("scripting.dictionary")
            .Item("январь") = 1
            .Item("февраль") = 2
            .Item("март") = 3
            .Item("апрель") = 4
            .Item("май") = 5
            .Item("июнь") = 6

            t = [c3].Value: m = [e3].Value: y = [f3].Value
            a = Sheets("База").[a2].CurrentRegion.Value
            ReDim b(1 To UBound(a), 1 To 4)

            For i = 1 To UBound(a)
                If a(i, 2) = t Then
                    If Year(CDate(a(i, 1))) = y Then
                        If Month(CDate(a(i, 1))) = .Item(m) Then
                            ii = ii + 1
                            b(ii, 1) = ii
                            b(ii, 2) = a(i, 1)
                            b(ii, 3) = a(i, 3)
                            b(ii, 4) = a(i, 7)
                        End If
                    End If
                End If
            Next

        End With

        If ii > 0 Then [a7].Resize(ii, 4) = b
    End If
End Sub

Внимание - там в оригинале "апреь"!
Я исправил у себя и на листе, и в коде

спасибо огромное

Hugo121

Будем дальше изучать и пытаться понять массивы и словари

[ХочуЗнать]

Hugo121!
СПАСИБО, СПАСИБО и СПАСИБО БОЛЬШОЕ!
Все работает.
Прикрепляю вариант на украинском. Может кому сгодится.

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

[Hugo121]

Я что-то начал помнить полностью наизусть только через пару лет активной помощи на форумах. Да и то меньше половины используемого. Да и то потому, что много помогал - для себя уже давно ничего писать не нужно.
Зазубривать нет смысла - достаточно иметь подборку примеров макросов, и знать ключевые слова, по которым можно в этой подборке искать.
Далее находим макрос, примерно делающий нужное, и изменяем (ну или из пары-тройки макросов комбинируем).
Что-то подсказывает редактор, что-то можно оперативно в хелпе найти.
Но конечно каждый макрос нужно полностью "читать", знать что где и как делается.
И главное - нужно уже иметь в голове готовый алгоритм, под который подбирать/писать код.
А алгоритм придумывается на основе тех приёмов и инструментов, которые уже знаешь.
Вот как здесь - можно копировать данные из листа в лист, перебирая cells, каждый раз увеличивая индекс. И вполне будет работать.
Но это дольше работает и много букв кода.
Быстрее и компактнее создать массив данных и массив для результатов, затем в цикле переложить нужное, выгрузить на лист.
Ещё вариант - использовать фильтр диапазона по двум столбцам. Но перебор массивов проще и надёжнее.
С номером месяца тоже есть другой путь - можно каждый раз перебирать массив названий, определяя его номер, или использовать в коде VLOOKUP/ВПР на виртуальном массиве или на данных с листа.
Но с словарём думаю проще.

Макрос в этой теме написан правда без использования "подборки макросов". Да тут и писать нечего - десяток простых строк...