[font=Times] Добрый день, уважаемые админы! Задача такая: как сделать, чтобы на листе "КК" в ячейках CDE5:CDE10 был перечень блюд (Лист "Страви") и при их выборе в столбец В вставлялись перечень продуктов по очереди выбора блюд, а в столбце С норма продукта на 1 человека умноженная на количество порций. Может стоит переделать таблицу на листе "Страви", потому что блюд будет намного больше? Прошу мне помочь с задачей.
[font=Times] Добрый день, уважаемые админы! Задача такая: как сделать, чтобы на листе "КК" в ячейках CDE5:CDE10 был перечень блюд (Лист "Страви") и при их выборе в столбец В вставлялись перечень продуктов по очереди выбора блюд, а в столбце С норма продукта на 1 человека умноженная на количество порций. Может стоит переделать таблицу на листе "Страви", потому что блюд будет намного больше? Прошу мне помочь с задачей.KorchiK
vikttur, этот пример я смотрел, но это не совсем то, что мне нужно. Извините, но я не сильный в Excel, может это и не функция ВПР. Подскажите, пожалуйста, тогда, что это за функция и как это можно сделать?
vikttur, этот пример я смотрел, но это не совсем то, что мне нужно. Извините, но я не сильный в Excel, может это и не функция ВПР. Подскажите, пожалуйста, тогда, что это за функция и как это можно сделать?KorchiK
У Вас Довольно серьезная для формул задача. По идее с ней нужно бы в ветку "Фриланс" направить. Но заинтересовало и так уж получилось, что сделал. Ловите
У Вас Довольно серьезная для формул задача. По идее с ней нужно бы в ветку "Фриланс" направить. Но заинтересовало и так уж получилось, что сделал. Ловите_Boroda_
Добрый день. Вариант макросом (выбираем блюда, жмем кнопку) [vba]
Код
Sub sbor_produktov() Dim arr_1() Dim arr_2() ReDim arr_1(0) ReDim arr_2(0) Set shS = Sheets("Страви") Set shK = Sheets("КК") 'On Error Resume Next With shS r = 18 shK.Range("B18:B38").ClearContents For x = 5 To 9 Set rFind = .Range("A1:A1000").Find(what:=shK.Cells(x, 3), lookat:=xlWhole) If Not rFind Is Nothing Then For c = 2 To .Cells(rFind.Row, Columns.Count).End(xlToLeft).Column Step 2 arr_1(UBound(arr_1)) = .Cells(rFind.Row, c) arr_2(UBound(arr_2)) = .Cells(rFind.Row, c + 1) * shK.Range("H5") ReDim Preserve arr_1(UBound(arr_1) + 1) ReDim Preserve arr_2(UBound(arr_2) + 1) Next c End If shK.Range(Cells(18, 3 * (x - 5) + 3), Cells(38, 3 * (x - 5) + 3)).ClearContents shK.Cells(r, 2).Resize(UBound(arr_1), 1).Value = Application.Transpose(arr_1) shK.Cells(r, 3 * (x - 5) + 3).Resize(UBound(arr_2), 1).Value = Application.Transpose(arr_2) r = r + UBound(arr_1) ReDim arr_1(0) ReDim arr_2(0) Next x End With End Sub
[/vba] если продуктов может быть более 21 (по текущему шаблону), то нужно будет немного переделать
Добрый день. Вариант макросом (выбираем блюда, жмем кнопку) [vba]
Код
Sub sbor_produktov() Dim arr_1() Dim arr_2() ReDim arr_1(0) ReDim arr_2(0) Set shS = Sheets("Страви") Set shK = Sheets("КК") 'On Error Resume Next With shS r = 18 shK.Range("B18:B38").ClearContents For x = 5 To 9 Set rFind = .Range("A1:A1000").Find(what:=shK.Cells(x, 3), lookat:=xlWhole) If Not rFind Is Nothing Then For c = 2 To .Cells(rFind.Row, Columns.Count).End(xlToLeft).Column Step 2 arr_1(UBound(arr_1)) = .Cells(rFind.Row, c) arr_2(UBound(arr_2)) = .Cells(rFind.Row, c + 1) * shK.Range("H5") ReDim Preserve arr_1(UBound(arr_1) + 1) ReDim Preserve arr_2(UBound(arr_2) + 1) Next c End If shK.Range(Cells(18, 3 * (x - 5) + 3), Cells(38, 3 * (x - 5) + 3)).ClearContents shK.Cells(r, 2).Resize(UBound(arr_1), 1).Value = Application.Transpose(arr_1) shK.Cells(r, 3 * (x - 5) + 3).Resize(UBound(arr_2), 1).Value = Application.Transpose(arr_2) r = r + UBound(arr_1) ReDim arr_1(0) ReDim arr_2(0) Next x End With End Sub
[/vba] если продуктов может быть более 21 (по текущему шаблону), то нужно будет немного переделатьsboy