Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/собрать данные из таблицы 1 в таблицу 2 по критериям - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
собрать данные из таблицы 1 в таблицу 2 по критериям
lexon992025 Дата: Четверг, 29.01.2026, 10:57 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 20% ±

Microsoft® Excel® 2021
Прописать формулу по 2 критериям.
Необходимо собрать данные из таблицы 1 в таблицу 2 по критериям.
Таблица разбита по блокам. Каждый блок это наименование статьи. В нее нужно затянуть по коду – наименование контрагента и его сумму.
К сообщению приложен файл: tablica.xlsx (11.5 Kb)


ТД
 
Ответить
СообщениеПрописать формулу по 2 критериям.
Необходимо собрать данные из таблицы 1 в таблицу 2 по критериям.
Таблица разбита по блокам. Каждый блок это наименование статьи. В нее нужно затянуть по коду – наименование контрагента и его сумму.

Автор - lexon992025
Дата добавления - 29.01.2026 в 10:57
msi2102 Дата: Четверг, 29.01.2026, 12:25 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 470
Репутация: 140 ±
Замечаний: 0% ±

Excel 2019
lexon992025, Добрый день! Скажите, а в статьях бывают разные коды статьи, например: "Материалы: Оборудование для видеонаблюдения, для КХО" код статьи только 1213600 или может быть ещё какой-то? Если контрагент встречается дважды в одной статье нужно складывать суммы?


Сообщение отредактировал msi2102 - Четверг, 29.01.2026, 12:26
 
Ответить
Сообщениеlexon992025, Добрый день! Скажите, а в статьях бывают разные коды статьи, например: "Материалы: Оборудование для видеонаблюдения, для КХО" код статьи только 1213600 или может быть ещё какой-то? Если контрагент встречается дважды в одной статье нужно складывать суммы?

Автор - msi2102
Дата добавления - 29.01.2026 в 12:25
msi2102 Дата: Четверг, 29.01.2026, 13:00 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 470
Репутация: 140 ±
Замечаний: 0% ±

Excel 2019
Не дождался ответа, сделал как понял:
[vba]
Код
Sub Макрос2()
    arr = Worksheets("Лист1").Range("B5:E" & Worksheets("Лист1").Cells(Rows.Count, "E").End(xlUp).Row)
    Set sd = CreateObject("Scripting.Dictionary")
    For n = 1 To UBound(arr)
        If Not sd.Exists(arr(n, 4)) Then Set sd(arr(n, 4)) = CreateObject("Scripting.Dictionary")
        If Not sd(arr(n, 4)).Exists(arr(n, 3)) Then Set sd(arr(n, 4))(arr(n, 3)) = CreateObject("Scripting.Dictionary"): k = k + 1
        If Not sd(arr(n, 4))(arr(n, 3)).Exists(arr(n, 1)) Then
            sd(arr(n, 4))(arr(n, 3)).Add arr(n, 1), arr(n, 2): k = k + 1
        Else
            sd(arr(n, 4))(arr(n, 3))(arr(n, 1)) = sd(arr(n, 4))(arr(n, 3))(arr(n, 1)) + CLng(arr(n, 2))
        End If
    Next
    ReDim arr_rez(1 To k, 1 To 3)
    n = 1: k = 1
    For Each y In sd
        arr_rez(n, 2) = y
        arr_rez(n, 1) = "блок " & k
        n = n + 1: k = k + 1
        For Each y1 In sd(y)
            For Each y2 In sd(y)(y1)
                arr_rez(n, 1) = y1
                arr_rez(n, 2) = y2
                arr_rez(n, 3) = sd(y)(y1)(y2)
                n = n + 1
            Next
        Next
    Next
    Worksheets("Лист1").Range("G5").Resize(UBound(arr_rez), 3) = arr_rez
End Sub
[/vba]
К сообщению приложен файл: tablica.xlsm (24.0 Kb)
 
Ответить
СообщениеНе дождался ответа, сделал как понял:
[vba]
Код
Sub Макрос2()
    arr = Worksheets("Лист1").Range("B5:E" & Worksheets("Лист1").Cells(Rows.Count, "E").End(xlUp).Row)
    Set sd = CreateObject("Scripting.Dictionary")
    For n = 1 To UBound(arr)
        If Not sd.Exists(arr(n, 4)) Then Set sd(arr(n, 4)) = CreateObject("Scripting.Dictionary")
        If Not sd(arr(n, 4)).Exists(arr(n, 3)) Then Set sd(arr(n, 4))(arr(n, 3)) = CreateObject("Scripting.Dictionary"): k = k + 1
        If Not sd(arr(n, 4))(arr(n, 3)).Exists(arr(n, 1)) Then
            sd(arr(n, 4))(arr(n, 3)).Add arr(n, 1), arr(n, 2): k = k + 1
        Else
            sd(arr(n, 4))(arr(n, 3))(arr(n, 1)) = sd(arr(n, 4))(arr(n, 3))(arr(n, 1)) + CLng(arr(n, 2))
        End If
    Next
    ReDim arr_rez(1 To k, 1 To 3)
    n = 1: k = 1
    For Each y In sd
        arr_rez(n, 2) = y
        arr_rez(n, 1) = "блок " & k
        n = n + 1: k = k + 1
        For Each y1 In sd(y)
            For Each y2 In sd(y)(y1)
                arr_rez(n, 1) = y1
                arr_rez(n, 2) = y2
                arr_rez(n, 3) = sd(y)(y1)(y2)
                n = n + 1
            Next
        Next
    Next
    Worksheets("Лист1").Range("G5").Resize(UBound(arr_rez), 3) = arr_rez
End Sub
[/vba]

Автор - msi2102
Дата добавления - 29.01.2026 в 13:00
lexon992025 Дата: Четверг, 29.01.2026, 13:03 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 20% ±

Microsoft® Excel® 2021
Код статьи присваивается только одной статье, в рамках статьи могут осуществляется закупки уже по направлению статью, например в рамках статьи "Материалы: Оборудование для видеонаблюдения, для КХО" можно закупить систему видеонаблюдения, маршрутизатор и т.д. Суммы складывать не нужно, т.к. у одного контрагента по одной статье может быть заключено несколько договоров по разным закупкам.


ТД
 
Ответить
СообщениеКод статьи присваивается только одной статье, в рамках статьи могут осуществляется закупки уже по направлению статью, например в рамках статьи "Материалы: Оборудование для видеонаблюдения, для КХО" можно закупить систему видеонаблюдения, маршрутизатор и т.д. Суммы складывать не нужно, т.к. у одного контрагента по одной статье может быть заключено несколько договоров по разным закупкам.

Автор - lexon992025
Дата добавления - 29.01.2026 в 13:03
msi2102 Дата: Четверг, 29.01.2026, 13:33 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 470
Репутация: 140 ±
Замечаний: 0% ±

Excel 2019
Пробуйте
[vba]
Код
Sub Макрос1()
    arr = Worksheets("Лист1").Range("B5:E" & Worksheets("Лист1").Cells(Rows.Count, "E").End(xlUp).Row)
    Set sd = CreateObject("Scripting.Dictionary")
    For n = 1 To UBound(arr)
        If Not sd.Exists(arr(n, 4) & "|" & arr(n, 3)) Then Set sd(arr(n, 4) & "|" & arr(n, 3)) = CreateObject("Scripting.Dictionary"): k = k + 1
        If Not sd(arr(n, 4) & "|" & arr(n, 3)).Exists(arr(n, 1)) Then Set sd(arr(n, 4) & "|" & arr(n, 3))(arr(n, 1)) = CreateObject("Scripting.Dictionary")
        sd(arr(n, 4) & "|" & arr(n, 3))(arr(n, 1)).Add n, arr(n, 2): k = k + 1
    Next
    ReDim arr_rez(1 To k, 1 To 3)
    n = 1: k = 1
    For Each y In sd
        arr_rez(n, 2) = Split(y, "|")(0)
        kod = Split(y, "|")(1)
        arr_rez(n, 1) = "блок " & k
        n = n + 1: k = k + 1
        For Each y1 In sd(y)
            For Each y2 In sd(y)(y1)
                arr_rez(n, 1) = kod 'y1
                arr_rez(n, 2) = y1
                arr_rez(n, 3) = sd(y)(y1)(y2)
                n = n + 1
            Next
        Next
    Next
    Worksheets("Лист1").Range("G5").Resize(UBound(arr_rez), 3) = arr_rez
End Sub

[/vba]
К сообщению приложен файл: 7867095.xlsm (27.0 Kb)
 
Ответить
СообщениеПробуйте
[vba]
Код
Sub Макрос1()
    arr = Worksheets("Лист1").Range("B5:E" & Worksheets("Лист1").Cells(Rows.Count, "E").End(xlUp).Row)
    Set sd = CreateObject("Scripting.Dictionary")
    For n = 1 To UBound(arr)
        If Not sd.Exists(arr(n, 4) & "|" & arr(n, 3)) Then Set sd(arr(n, 4) & "|" & arr(n, 3)) = CreateObject("Scripting.Dictionary"): k = k + 1
        If Not sd(arr(n, 4) & "|" & arr(n, 3)).Exists(arr(n, 1)) Then Set sd(arr(n, 4) & "|" & arr(n, 3))(arr(n, 1)) = CreateObject("Scripting.Dictionary")
        sd(arr(n, 4) & "|" & arr(n, 3))(arr(n, 1)).Add n, arr(n, 2): k = k + 1
    Next
    ReDim arr_rez(1 To k, 1 To 3)
    n = 1: k = 1
    For Each y In sd
        arr_rez(n, 2) = Split(y, "|")(0)
        kod = Split(y, "|")(1)
        arr_rez(n, 1) = "блок " & k
        n = n + 1: k = k + 1
        For Each y1 In sd(y)
            For Each y2 In sd(y)(y1)
                arr_rez(n, 1) = kod 'y1
                arr_rez(n, 2) = y1
                arr_rez(n, 3) = sd(y)(y1)(y2)
                n = n + 1
            Next
        Next
    Next
    Worksheets("Лист1").Range("G5").Resize(UBound(arr_rez), 3) = arr_rez
End Sub

[/vba]

Автор - msi2102
Дата добавления - 29.01.2026 в 13:33
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2026 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!