Страницы: 1
RSS
Сведение значений нескольких ячеек в одну, на основе заданных условий, заменить множество однотипных макросов одним
 
Доброго времени!

Задача следует из названия темы, необходимо заменить множество однотипных макросов (~10 штук) одним.
Макросы отличаются тем, что каждый прописан под свою конкретную строку, т.е. "Макрос1" для строки 21, "Макрос2" для строки 22 и т.д.
В зависимости от макроса (т.е. строки) выбираются разные столбцы с данными в файле "К2" и начальная ячейка для записи результата. К примеру, строке 21 соответствует столбец C и первой ячейкой с результатом будет E21, строке 22 - столбец D и первая ячейка с результатом E22 и т.п.

Отличия в коде:
Код
Макрос1
Set mm = m.Offset(0, 2)
If arr2(1, i) = arr(n, 3) And arr(n, 15) = m And arr3(n, 2) = mm Then

Макрос2
Set mm = m.Offset(1, 2)
If arr2(1, i) = arr(n, 4) And arr(n, 15) = m And arr3(n, 2) = mm Then

Что конкретно хочется получить:
Один макрос, который будет проверять данные из столбца "Условие 3" и исходя из них выполнять определенные действия. Т.е. в ячейке D21 у нас цифра 1, значит берем столбец с данными C и пишем результат начиная с ячейки E21, в ячейке D22 цифра 2, значит берем столбец D и результат с ячейки D22
Значения типа "1= столбец D", "2 = С", "3 = ...." будут прописываться в коде заранее руками, нужно понимать как это сделать.

Необходимо из файла "К2" в файл "К1" вывести диапазоном все значения ячеек, попадающих под определенные условия обозначенные в файле "К1".
Три условия - цифры, четвертое условие дата. "Условие 3" меняется в зависимости от строки (удаленности от Условия 1) и, соответственно, меняет условие поиска (столбец) в файле "К2".

Основной файл с макросами "К1" и файл с данными "К2" прикрепил. Если нужно описание работы самого макроса или какая-то другая важная информация - прошу написать.
 
Andrey,покажите в файле желаемый результат ручками и опишите что выбрано то-то и поэтому это получается
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
Andrey написал:
макрос, который будет проверять данные из столбца "Условие 3" и исходя из них выполнять определенные действия...  каждый прописан под свою конкретную строку
Код
If "условие из столбца 3" And "другое условие" And "еще условие" Then ' и так все условия
    действие
End If
Это и будет в одном макросе. Если не получается задать условия или наладить работу макроса - создайте тему с соответствующим названием и понятным примером :)
Изменено: _Igor_61 - 23.05.2021 15:10:45
 
Прикрепил обновленные файлы.

Файл "К1", ячейка E21, результат "1-3".
1) Условие1 из ячейки А21 = 1005 (в файле "К2" осуществляется поиск этого значения по столбцу О)
2) Условие2 из ячейки С21 = 1 (в файле "К2" осуществляется поиск этого значения по столбцу В)
3 Условие3 из ячейки D21 = 1 (значит в файле "К2" осуществляется поиск даты E20 (01.06.2021) из столбца C)
все строки файла "К2" проверены, под все условия попало 3 строки, у которых по столбцу А значения равны 1, 2 и 3. Т.к. значения последовательны, выводится результат "1-3".
Этому соответствует код:

       со строкой    If arr2(1, i) = arr(n, 3) And arr(n, 15) = m And arr3(n, 2) = mm Then
Код
Sub Ìàêðîñ1()
    Dim arr, arr2, arr3, arr4, i As Long, n As Long, lr As Long, lcol As Long, tt As String, col As New Collection, fl As Boolean, m As Range, mm As Range, mmm As Range
    Set m = [A21]
    Set mm = m.Offset(0, 2)
    Set mmm = mm.Offset(0, 2)
    Set wb = ThisWorkbook: Set wb2 = Workbooks("Ê2.xlsx")
    lr = wb2.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
    lcol = Cells(20, Columns.Count).End(xlToLeft).Column
    arr = wb2.Sheets(2).Range("A2:O" & lr)
    arr2 = wb.Sheets(1).Range(Cells(20, 5), Cells(20, lcol))
    arr3 = wb2.Sheets(2).Range("A2:O" & lr)
    ReDim arr4(1 To 1, 1 To UBound(arr2, 2) - LBound(arr2) + 1): K = 1
    For i = LBound(arr2) To UBound(arr2, 2) - LBound(arr2) + 1
        tt = ""
        Set col = Nothing
        For n = LBound(arr) To UBound(arr)
            If arr2(1, i) = arr(n, 3) And arr(n, 15) = m And arr3(n, 2) = mm Then
                On Error Resume Next
                col.Add arr(n, 1), CStr(arr(n, 1))
            End If
        Next n
        For n = 1 To col.Count
            tt = tt & ", " & col(n)
            Do While col(n) = col(n + 1) - 1 And n < col.Count
                fl = True: n = n + 1
                If n >= col.Count Then Exit Do
            Loop
            If fl Then tt = tt & "-" & col(n): fl = False
        Next n
        arr4(1, K) = Mid(tt, 3): K = K + 1
    Next i
    mmm.Resize(1, UBound(arr4, 2) - LBound(arr4) + 1).NumberFormat = "@"
    mmm.Resize(1, UBound(arr4, 2) - LBound(arr4) + 1) = arr4
End Sub


Файл "К1", ячейка E25, результат "пусто" (нет данных)

Файл "К1", ячейка F25, результат 1-5, 8"
1) Условие1 из ячейки А21 = 1005 (в файле "К2" осуществляется поиск этого значения по столбцу О)
2) Условие2 из ячейки С25 = 1 (в файле "К2" осуществляется поиск этого значения по столбцу В)
3 Условие3 из ячейки D21 = 5 (значит в файле "К2" осуществляется поиск даты F20 (02.06.2021) из столбца E)
все строки файла "К2" проверены, под все условия попало 6 строк, у которых по столбцу А значения равны 1, 2, 3, 4, 5 и 8. Т.к. значения 1, 2, 3, 4, 5 последовательны, а 8 нет, выводится результат "1-5, 8"

Этому соответствует код:

Скрытый текст
 
Цитата
_Igor_61 написал:
Это и будет в одном макросе. Если не получается задать условия или наладить работу макроса - создайте тему с соответствующим названием и понятным примером
Возможно я вас не совсем правильно понял, но
я приложил файл, в нем макрос и так проверяет условия через "IF условие из столбца3 and условие and условие "
проблема заключается в том, что я не могу понять, как задать в одном макросе изменение столбцов с данными исходя из условия3.
Выше описал пример того, что должно получится, надеюсь, что более понятно, чем в первом посте
Изменено: Andrey - 23.05.2021 15:15:37
 
Все еще мучаюсь с решением данной задачи. Если у кого-то есть смысли, как решить проблему - прошу подсказать.
Пробовал объединять эти однотипные макросы в один, через "если" (If) и, в зависимости от результата "если", менять данные макросах. Результат нулевой, только еще больше запутался.
Технически макрос работает идеально, но проблема заключается именно в том, что каждая строка - отдельный макрос. Соответственно 100 строк - 100 макросов (с ручной корректировкой данных в 3х местах каждого макроса). Если бы можно было сделать отсчет от определенной ячейки для всех этих 100 строк, было бы отлично.
Изменено: Andrey - 25.05.2021 18:30:49
Страницы: 1
Наверх