查看 sheet 1 上 B 列中的单词是否为 1 或 0，如果第 3 行中 sheet 2 中的 1 个查找单词和该单词下方的 return 列表

Question

我已尝试修复我在论坛中找到的答案中的代码，但我做不到。

我的问题是：

我有一份 sheet 周的食谱名称列表，我想用 1 或 0 来决定下周我想准备哪些菜谱。在 sheet 食谱中，我列出了食谱及其配料表。我想在 Sheet 5 中输出我需要购买的东西。在 sheet 周内如果 B 列 = 1，则取 A 列中的配方名称；在 sheet 食谱第 3 行中查找食谱名称，并在 sheet 3（购物清单）下方的 return 成分列表中查找。

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" & 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

以下是部分截图：

Answer 1

我在几个区域留下了评论来解释代码的一般作用。

如评论中所述 - 基本思想是沿包含配方名称的行执行 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" & 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 <> 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" & 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

查看 sheet 1 上 B 列中的单词是否为 1 或 0，如果第 3 行中 sheet 2 中的 1 个查找单词和该单词下方的 return 列表

See if word in column B on sheet 1 is 1 or 0, if 1 lookup word in sheet 2 in row 3 and return list below that word

excel

vba

lookup

offset