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

Вход

Регистрация

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

 

= Мир MS Excel/Подтягивание и суммирование ингредиентов, из неск-х списков - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Подтягивание и суммирование ингредиентов, из неск-х списков
pankkris Дата: Вторник, 14.05.2024, 11:27 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте! Как порядочная домохозяйка, пытаюсь упростить себе жизнь. И меня посетила "гениальная" идея создания в эксель автоматического списка покупок.
В общем и целом имеется:
Лист 1 (Меню) - на нем условный календарик на 5 недель, с расписанием удобным для меня, когда и что готовить. Сделала всё выпадающими списками, что бы при желании менять блюда под обстоятельства. Рядом таблица со списком продуктов (с ней у меня и проблема, к этому вернусь с объяснениями)
Лист 2 (Рецепты) - просто огромная табличка где в первой колонке расписаны блюда (Толченка, Сырный, Котлеты) по категориям (Гарниры, Мясо, Суп) и по горизонтали продукты, расписанные как рецепты.

И вот в чем проблема/трудность/задача/
Прошел месяц, я захожу в таблицу, выставляю из выплывающих списках новое меню на месяц, нажимаю на номер недели в списке покупок и он автоматически выдает те продукты и в том количестве что мне нужно из меню которое я выставила.
При этом всем, естественно количество Блюд и Продуктов будет добавляться.

Не уверенна понятно ли, что имеется и что хочу, но это 100% используется в складском учёте и в подобном направлении

В конце концом, может как то по другому организовать всю эту систему, но смысл должен остаться тот же - зашел выбрал блюда, и рядом БАХ список продуктов на неделю, это просто потрясающе удобно

И возможно есть темы, которые подобное уже разбирали, но я не знаю как это называется, что бы найти. В общем, за любую помощь буду благодарна ^_^

Файл с Меню прикреплен :D
К сообщению приложен файл: menju.xlsx (23.0 Kb)
 
Ответить
СообщениеЗдравствуйте! Как порядочная домохозяйка, пытаюсь упростить себе жизнь. И меня посетила "гениальная" идея создания в эксель автоматического списка покупок.
В общем и целом имеется:
Лист 1 (Меню) - на нем условный календарик на 5 недель, с расписанием удобным для меня, когда и что готовить. Сделала всё выпадающими списками, что бы при желании менять блюда под обстоятельства. Рядом таблица со списком продуктов (с ней у меня и проблема, к этому вернусь с объяснениями)
Лист 2 (Рецепты) - просто огромная табличка где в первой колонке расписаны блюда (Толченка, Сырный, Котлеты) по категориям (Гарниры, Мясо, Суп) и по горизонтали продукты, расписанные как рецепты.

И вот в чем проблема/трудность/задача/
Прошел месяц, я захожу в таблицу, выставляю из выплывающих списках новое меню на месяц, нажимаю на номер недели в списке покупок и он автоматически выдает те продукты и в том количестве что мне нужно из меню которое я выставила.
При этом всем, естественно количество Блюд и Продуктов будет добавляться.

Не уверенна понятно ли, что имеется и что хочу, но это 100% используется в складском учёте и в подобном направлении

В конце концом, может как то по другому организовать всю эту систему, но смысл должен остаться тот же - зашел выбрал блюда, и рядом БАХ список продуктов на неделю, это просто потрясающе удобно

И возможно есть темы, которые подобное уже разбирали, но я не знаю как это называется, что бы найти. В общем, за любую помощь буду благодарна ^_^

Файл с Меню прикреплен :D

Автор - pankkris
Дата добавления - 14.05.2024 в 11:27
Nic70y Дата: Вторник, 14.05.2024, 14:04 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 9005
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
вдруг правильно
[vba]
Код
Sub xs()
    Application.ScreenUpdating = False
    'очистим старый список
    a = Cells(Rows.Count, "k").End(xlUp).Row 'нижняя ячейка списка
    If a > 3 Then Range("k4:l" & a).Clear
    'определим размеры* таблицы на листе Рецепты
    b = Sheets("Рецепты").Cells(Rows.Count, "b").End(xlUp).Row          'нижняя строка
    c = Sheets("Рецепты").Cells(4, Columns.Count).End(xlToLeft).Column  'правый столбец
    'определим диапазон недели
    d = Range("m2").Value
    e = Application.Match(d, Range("a:a"), 0)           'верхняя строка
    f = Range("a" & e).MergeArea.Cells.Count + e - 1    'нижняя строка
    'пройдемся циклом по неделе
    For Each g In Range("b" & e & ":h" & f)
        h = g.Value 'значение ячейки
        If h <> "" Then
            i = Application.Match(h, Sheets("Рецепты").Range("b1:b" & b), 0) 'строка блюда
            j = Application.Count(Range(Sheets("Рецепты").Cells(i, 3), Sheets("Рецепты").Cells(i, c))) 'кол-во инг.
            'вытащим ингридиенты
            If j > 0 Then
                k = 2 'начальный столбец
                For l = 1 To j
                    m = Sheets("Рецепты").Cells(i, k).End(xlToRight).Column 'столбец со значанием
                    n = Sheets("Рецепты").Cells(i, m).Value 'вес*
                    o = Sheets("Рецепты").Cells(4, m).Value 'наименование
                    p = Cells(Rows.Count, "k").End(xlUp).Row + 1    'строка вставки (1)
                    q = Application.Match(o, Range("k4:k" & p), 0)  'строка вставки (2)
                    If IsNumeric(q) Then
                        q = q + 3
                        Range("l" & q) = Range("l" & q).Value + n
                    Else
                        Range("k" & p) = o
                        Range("l" & p) = n
                    End If
                    k = m '
                Next
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: menju_2.xlsm (35.5 Kb)


ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Вторник, 14.05.2024, 14:28
 
Ответить
Сообщениевдруг правильно
[vba]
Код
Sub xs()
    Application.ScreenUpdating = False
    'очистим старый список
    a = Cells(Rows.Count, "k").End(xlUp).Row 'нижняя ячейка списка
    If a > 3 Then Range("k4:l" & a).Clear
    'определим размеры* таблицы на листе Рецепты
    b = Sheets("Рецепты").Cells(Rows.Count, "b").End(xlUp).Row          'нижняя строка
    c = Sheets("Рецепты").Cells(4, Columns.Count).End(xlToLeft).Column  'правый столбец
    'определим диапазон недели
    d = Range("m2").Value
    e = Application.Match(d, Range("a:a"), 0)           'верхняя строка
    f = Range("a" & e).MergeArea.Cells.Count + e - 1    'нижняя строка
    'пройдемся циклом по неделе
    For Each g In Range("b" & e & ":h" & f)
        h = g.Value 'значение ячейки
        If h <> "" Then
            i = Application.Match(h, Sheets("Рецепты").Range("b1:b" & b), 0) 'строка блюда
            j = Application.Count(Range(Sheets("Рецепты").Cells(i, 3), Sheets("Рецепты").Cells(i, c))) 'кол-во инг.
            'вытащим ингридиенты
            If j > 0 Then
                k = 2 'начальный столбец
                For l = 1 To j
                    m = Sheets("Рецепты").Cells(i, k).End(xlToRight).Column 'столбец со значанием
                    n = Sheets("Рецепты").Cells(i, m).Value 'вес*
                    o = Sheets("Рецепты").Cells(4, m).Value 'наименование
                    p = Cells(Rows.Count, "k").End(xlUp).Row + 1    'строка вставки (1)
                    q = Application.Match(o, Range("k4:k" & p), 0)  'строка вставки (2)
                    If IsNumeric(q) Then
                        q = q + 3
                        Range("l" & q) = Range("l" & q).Value + n
                    Else
                        Range("k" & p) = o
                        Range("l" & p) = n
                    End If
                    k = m '
                Next
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 14.05.2024 в 14:04
pankkris Дата: Среда, 15.05.2024, 05:26 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Nic70y, божечки спасибо! Да всё работает и это вау вау вау!
Спасибо! hands

Вопрос решен
:heart:
 
Ответить
СообщениеNic70y, божечки спасибо! Да всё работает и это вау вау вау!
Спасибо! hands

Вопрос решен
:heart:

Автор - pankkris
Дата добавления - 15.05.2024 в 05:26
pankkris Дата: Вторник, 21.05.2024, 07:29 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Если притянуться еще к ингредиентам и единицы измерения с отделом... yes
и пожалуйста, сделайте диапазон таблицы с ингредиентами безграничным, что бы можно было добавлять рецепты yes
К сообщению приложен файл: menju.xlsm (37.8 Kb)
 
Ответить
СообщениеЕсли притянуться еще к ингредиентам и единицы измерения с отделом... yes
и пожалуйста, сделайте диапазон таблицы с ингредиентами безграничным, что бы можно было добавлять рецепты yes

Автор - pankkris
Дата добавления - 21.05.2024 в 07:29
Nic70y Дата: Вторник, 21.05.2024, 09:00 | Сообщение № 5
Группа: Друзья
Ранг: Экселист
Сообщений: 9005
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
pankkris, подправил, проверяйте
сделайте диапазон таблицы с ингредиентами безграничным
он безграничен
вот этот момент
m = Sheets("Рецепты").Cells(i, k).End(xlToRight).Column
был неверен (не учел подряд идущие)
главное это структура таблицы
К сообщению приложен файл: menju3_1.xlsm (39.2 Kb)


ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Вторник, 21.05.2024, 09:02
 
Ответить
Сообщениеpankkris, подправил, проверяйте
сделайте диапазон таблицы с ингредиентами безграничным
он безграничен
вот этот момент
m = Sheets("Рецепты").Cells(i, k).End(xlToRight).Column
был неверен (не учел подряд идущие)
главное это структура таблицы

Автор - Nic70y
Дата добавления - 21.05.2024 в 09:00
pankkris Дата: Среда, 22.05.2024, 05:37 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Да теперь все шикардос, спасибо! hands
 
Ответить
СообщениеДа теперь все шикардос, спасибо! hands

Автор - pankkris
Дата добавления - 22.05.2024 в 05:37
  • Страница 1 из 1
  • 1
Поиск:

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