Блог

Я попытался исправить код из ответов, которые я нашел на форуме, но у меня ничего не получается.

Моя проблема в том, что:

У меня есть список названий рецептов в неделях листа, и я хочу решить с помощью 1 или 0, какие из них я хочу приготовить на следующую неделю. В разделе Рецепты на листе у меня есть рецепты, перечисленные ниже, со списком ингредиентов. Я хотел бы получить вывод о том, что мне нужно для покупок, на листе 5. В неделях листа, если столбец B = 1, укажите название рецепта в столбце A; Имя рецепта Hlookup в строке 3 рецептов листа и верните список ингредиентов ниже на лист 3 (список покупок).

 Sub Output_Shoopinglist()   Dim ws As Worksheet ' define worksheet  Set ws = ThisWorkbook.Worksheets("Weeks")    Dim LastRow As Long ' get last used row in column b  LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row    Dim DataRange As Range ' get data range  Set DataRange = ws.Range("B3", "C20" amp; LastRow)    Dim DataArray() As Variant ' read data into an array (for fast processing)  DataArray = DataRange.Value    Dim OutputData As Collection ' create a collection where we collect all desired data  Set OutputData = New Collection    ' check each data row and if desired add to collection  Dim iRow As Long  For iRow = LBound(DataArray, 1) To UBound(DataArray, 1)  If DataArray(iRow, 2) = 1 Then  OutputData.Add DataArray(iRow, 1)  End If  Next iRow      Dim wsTemplate As Worksheet  Set wsTemplate = ThisWorkbook.Worksheets("Recipes")    Dim wsVolume As Worksheet  Set wsVolume = ThisWorkbook.Worksheets("Shopping list")    'Lookup Value in Tab Recipes in row 3, and return Ingrediants list one below the other in tab Shopping list in Column B  'Here I am missing code:    End Sub  

Вот несколько скриншотов:

Я оставил комментарии в нескольких областях, чтобы объяснить, что делает код в целом.

Как упоминалось в комментарии — Основная идея состоит в том, чтобы выполнить Find метод вдоль строки, содержащей название рецепта, и если он будет найден, номер столбца найденной ячейки будет использоваться для извлечения списка ингредиентов (и количества, которое составляет 1 столбец ранее), которое написано под названиями рецептов.

Как только список будет извлечен в массиве, он сразу же будет использоваться для записи в рабочий лист списка покупок.

 Option Explicit  Const WSNAME_WEEK As String = "Weeks" Const WSNAME_RECIPES As String = "Recipes" Const WSNAME_SHOPPING As String = "Shopping list"  Sub Output_Shoppinglist()   Dim ws As Worksheet ' define worksheet  Set ws = ThisWorkbook.Worksheets(WSNAME_WEEK)    Dim lastRow As Long ' get last used row in column b  lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row    Dim DataRange As Range ' get data range  Set DataRange = ws.Range("B4:C" amp; lastRow)    Dim DataArray() As Variant ' read data into an array (for fast processing)  DataArray = DataRange.Value    Dim OutputData As Collection ' create a collection where we collect all desired data  Set OutputData = New Collection    ' check each data row and if desired add to collection  Dim iRow As Long  For iRow = LBound(DataArray, 1) To UBound(DataArray, 1)  If DataArray(iRow, 2) = 1 Then  OutputData.Add DataArray(iRow, 1)  End If  Next iRow    If OutputData.Count lt;gt; 0 Then ' Uncomment if you need to clear the shopping list prior to inserting this batch of list of ingredients ' With ThisWorkbook.Worksheets(WSNAME_SHOPPING) ' Dim shoppingLastRow As Long ' shoppingLastRow = .Cells(.Rows.Count, 2).Row ' .Range("A2:B" amp; shoppingLastRow).Value = "" ' End With    '1. Loop through the collection,  '2. Pass the recipe name to GetIngredients to retrieve the list of ingredients (in an array) from Recipes worksheet  '3. Pass the array to WriteToShoppingList for writing into the Shopping list worksheet  Dim i As Long  For i = 1 To OutputData.Count  'Get the ingredient list from Recipes sheet  Dim ingredList As Variant  ingredList = GetIngredients(OutputData(i))    If Not IsEmpty(ingredList) Then WriteToShoppingList ingredList  Next i  End If    MsgBox "Done!" End Sub  Function GetIngredients(argRecipeName As String) As Variant  Const firstRow As Long = 7 'Change this to whichever row the first ingredient should be on  Const recipesNameRow As Long = 3    Dim wsTemplate As Worksheet  Set wsTemplate = ThisWorkbook.Worksheets(WSNAME_RECIPES)    '==== Do a Find on row with the recipe names  Dim findCell As Range  Set findCell = wsTemplate.Rows(recipesNameRow).Find(argRecipeName, LookIn:=xlValues, LookAt:=xlWhole)    If Not findCell Is Nothing Then  '==== If found, assign the value of the ingredients (from firstRow to the last row) into an array    Dim lastRow As Long  lastRow = wsTemplate.Cells(firstRow, findCell.Column).End(xlDown).Row    Dim ingredRng As Range  Set ingredRng = wsTemplate.Range(wsTemplate.Cells(firstRow, findCell.Column), wsTemplate.Cells(lastRow, findCell.Column)).Offset(, -1).Resize(, 2)    Dim ingredList As Variant  ingredList = ingredRng.Value   GetIngredients = ingredList  End If  End Function  Sub WriteToShoppingList(argIngredients As Variant)  Dim wsVolume As Worksheet  Set wsVolume = ThisWorkbook.Worksheets(WSNAME_SHOPPING)    Dim lastRow As Long  lastRow = wsVolume.Cells(wsVolume.Rows.Count, 2).End(xlUp).Row    wsVolume.Cells(lastRow   1, 1).Resize(UBound(argIngredients, 1), 2).Value = argIngredients End Sub