Excel VBA代码修改需求：合并相同食材行并拼接对应列内容

嗨，我来帮你搞定这个VBA代码的修改需求！你的目标很明确：把原来分散在多行的相同食材（比如示例里的Onions）合并成单独一行，同时把对应的Meal Type、Particular这些列的内容拼接在一起，对吧？

我给你调整后的VBA代码，核心思路是用字典来追踪每个食材对应的其他列内容，遍历数据时自动合并重复项，最后再把整理好的数据输出：

Sub MergeIngredientRows()
    Dim wsSource As Worksheet
    Dim wsResult As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim ingredientDict As Object
    Dim currentIngredient As String
    Dim currentMealType As String
    Dim currentParticular As String
    Dim resultRow As Long
    
    ' 设置源工作表和结果工作表（你可以根据实际表名修改）
    Set wsSource = ThisWorkbook.Worksheets("Dishes") ' 假设你的源数据在这个表
    Set wsResult = ThisWorkbook.Worksheets("Ingredients") ' 结果输出到这个表
    Set ingredientDict = CreateObject("Scripting.Dictionary")
    
    ' 清空结果表原有内容（可选，根据需要调整）
    wsResult.UsedRange.Clear
    
    ' 获取源数据最后一行
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历源数据（假设表头在第1行，从第2行开始遍历）
    For i = 2 To lastRow
        currentIngredient = Trim(wsSource.Cells(i, "A").Value) ' 假设Ingredient在A列
        currentMealType = Trim(wsSource.Cells(i, "B").Value) ' Meal Type在B列
        currentParticular = Trim(wsSource.Cells(i, "C").Value) ' Particular在C列
        
        If ingredientDict.Exists(currentIngredient) Then
            ' 如果食材已存在，拼接对应的列内容（用逗号分隔，你可以换成其他分隔符比如换行符vbCrLf）
            ingredientDict(currentIngredient) = Array( _
                ingredientDict(currentIngredient)(0) & ", " & currentMealType, _
                ingredientDict(currentIngredient)(1) & ", " & currentParticular _
            )
        Else
            ' 如果食材不存在，新增字典条目
            ingredientDict(currentIngredient) = Array(currentMealType, currentParticular)
        End If
    Next i
    
    ' 把字典里的数据写入结果表
    resultRow = 2 ' 结果表表头在第1行的话，从第2行开始写
    wsResult.Cells(1, "A").Value = "Ingredient"
    wsResult.Cells(1, "B").Value = "Meal Type"
    wsResult.Cells(1, "C").Value = "Particular"
    
    For Each key In ingredientDict.Keys
        wsResult.Cells(resultRow, "A").Value = key
        wsResult.Cells(resultRow, "B").Value = ingredientDict(key)(0)
        wsResult.Cells(resultRow, "C").Value = ingredientDict(key)(1)
        resultRow = resultRow + 1
    Next key
    
    ' 自动调整列宽
    wsResult.UsedRange.Columns.AutoFit
    
    MsgBox "食材合并完成！", vbInformation
End Sub

关键部分说明： #

• 字典对象：用Scripting.Dictionary来快速判断食材是否已经出现过，避免重复遍历，效率更高。
• 内容拼接：如果遇到重复食材，就把对应的Meal Type和Particular用逗号（你可以改成vbCrLf实现换行拼接）连接起来。
• 数据输出：遍历字典的所有键值对，把整理好的一行行数据写入结果工作表，自动生成合并后的效果。

你可以根据自己实际的列位置、表名，修改代码里的工作表名称和列索引（比如A/B/C列对应你的实际列），测试下就能得到你想要的效果啦！

备注：内容来源于stack exchange，提问作者azlandfaqs