Страницы: 1
RSS
Поиск по трем значениям с выводом результата в заданную ячейку., Поиск по трем значениям
 
Доброго дня дорогие форумчане. Подскажите по написанию формулы или макроса в таблицы для вывода данных по трем значениям
В примере на первом листе вывод значений, на втором подставляемые значения общим списком.  
 
sergey82, предложите новое название темы, из которого будет понятна задача - модераторы поменяют.
 
Как поменять?
Поиск по трем значениям с постановкой в заданную ячейку.
 
Цитата
sergey82 написал:
Как поменять?
Цитата
Юрий М написал:
предложите новое название
 
Цитата
Юрий М написал:
Юрий М  написал:предложите новое название
Поиск по трем значениям с постановкой в заданную ячейку.
 
Цитата
sergey82 написал:
с постановкой
Да что же у Вас с формулировками - прям беда.
Постановка - это совсем из другой оперы )) Название поменял.
 
Юрий М, Извините, я чайник, почти самовар(
 
sergey82, а может сводная подойдет?
 
Андрей Лящук, В том то и дело, что нужна формула или макрос для ячейки.
 
Доброе время суток.
А СУММЕСЛИМН - не подходит? По примеру не понятно, что откуда берётся и какие столбцы - критерий.
 
Андрей VG, Добрый день
Чет крутил и так и эдок, ни как не выходит. Вот и решил спросить у знатоков.
 
Цитата
sergey82 написал:
Чет крутил и так и эдок, ни как не выходит
Дык, если и вам не известно
Цитата
Андрей VG написал:
что откуда берётся и какие столбцы - критерий.
то боюсь никто не сможет помочь :(
 
sergey82 Добрый день! Попробуйте в ячейку В4 первого листа ввести формулу
Код
=СУММЕСЛИМН(Лист2!D:D;Лист2!A:A;$A$1;Лист2!B:B;$A$4;Лист2!C:C;A4).
Затем изменяя диапазоны суммирования и условия суммирования Вы получите желаемый результат. Если, конечно, я угадал то, что вы хотите получить... :-)
 
sergey82, макрос работает медленно, но работу выполняет.
Код
Sub csg()
Dim a&, b&, c&, i&, lr1&, lr2&
Dim sh As Worksheet
Application.ScreenUpdating = False
lr1 = Cells(Rows.Count, "A").End(xlUp).Row - 9
Set sh = Sheets(2)
lr2 = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
For a = 1 To lr1 Step 11
   For b = 2 To 6 Step 2
       For c = a + 3 To a + 9
           For i = 2 To lr2
               If Cells(a, 1) = sh.Cells(i, 1) And Cells(a + 2, b) = sh.Cells(i, 2) And Cells(c, 1) = sh.Cells(i, 3) Then
                   sh.Range(sh.Cells(i, 4), sh.Cells(i, 5)).Copy Cells(c, b)
               End If
            Next
        Next
     Next
        Cells(a + 3, 2) = WorksheetFunction.Sum(Range(Cells(a + 3, 2), Cells(a + 9, 2)))
        Cells(a + 3, 3) = WorksheetFunction.Sum(Range(Cells(a + 3, 3), Cells(a + 9, 3)))
        Cells(a + 3, 4) = WorksheetFunction.Sum(Range(Cells(a + 3, 4), Cells(a + 9, 4)))
        Cells(a + 3, 5) = WorksheetFunction.Sum(Range(Cells(a + 3, 5), Cells(a + 9, 5)))
        Cells(a + 3, 6) = WorksheetFunction.Sum(Range(Cells(a + 3, 6), Cells(a + 9, 6)))
        Cells(a + 3, 7) = WorksheetFunction.Sum(Range(Cells(a + 3, 7), Cells(a + 9, 7)))
 Next
Application.ScreenUpdating = True
End Sub
Изменено: casag - 25.08.2019 21:55:59
 
sergey82, Так будет быстрее
Код
Sub csg()
    Dim m(), n()
Dim a&, b&, c&, i&, lr&
    With Sheets(1)
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        m = Range(.[g1], .Range("A" & lr)).Value
    End With

    With Sheets(2)
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        n = Range(.[e1], .Range("A" & lr)).Value
    End With
For a = 1 To UBound(m) Step 11
   For b = 2 To 6 Step 2
       For c = a + 3 To a + 9
           For i = 2 To UBound(n)
               If m(a, 1) = n(i, 1) And m(a + 2, b) = n(i, 2) And m(c, 1) = n(i, 3) Then
                   m(c, b) = n(i, 4)
                   m(c, b + 1) = n(i, 5)
               End If
            Next
        Next
     Next
      m(a + 3, 2) = WorksheetFunction.Sum(m(a + 3, 2), m(a + 4, 2), m(a + 5, 2), m(a + 6, 2), m(a + 7, 2), m(a + 8, 2), m(a + 9, 2))
      m(a + 3, 3) = WorksheetFunction.Sum(m(a + 3, 3), m(a + 4, 3), m(a + 5, 3), m(a + 6, 3), m(a + 7, 3), m(a + 8, 3), m(a + 9, 3))
      m(a + 3, 4) = WorksheetFunction.Sum(m(a + 3, 4), m(a + 4, 4), m(a + 5, 4), m(a + 6, 4), m(a + 7, 4), m(a + 8, 4), m(a + 9, 4))
      m(a + 3, 5) = WorksheetFunction.Sum(m(a + 3, 5), m(a + 4, 5), m(a + 5, 5), m(a + 6, 5), m(a + 7, 5), m(a + 8, 5), m(a + 9, 5))
      m(a + 3, 6) = WorksheetFunction.Sum(m(a + 3, 6), m(a + 4, 6), m(a + 5, 6), m(a + 6, 6), m(a + 7, 6), m(a + 8, 6), m(a + 9, 6))
      m(a + 3, 7) = WorksheetFunction.Sum(m(a + 3, 7), m(a + 4, 7), m(a + 5, 7), m(a + 6, 7), m(a + 7, 7), m(a + 8, 7), m(a + 9, 7))
 Next
 Sheets(1).[a1].Resize(UBound(m), 7) = m
Application.ScreenUpdating = True
End Sub
Страницы: 1
Наверх