Excel多列分类汇总需求：非Pivot table/Countif智能方案求助

直接用VBA脚本处理原始格式的数据，不用手动调整数据源结构，操作步骤如下：

1. 打开目标Excel文件，按下Alt + F11打开VBA编辑器。
2. 插入新模块：右键左侧工程窗口的工作簿名称 → 插入 → 模块。
3. 将以下代码粘贴到模块中：

Sub 场景食材汇总()
    Dim wsSource As Worksheet, wsResult As Worksheet
    Dim lastRow As Long, i As Long, j As Long, k As Long
    Dim sceneDict As Object, foodDict As Object
    Dim scenes() As String, foods() As String
    Dim scene As String, food As String
    
    ' 指定原始数据所在工作表（把"Sheet1"改成你的实际表名）
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    ' 创建/复用汇总结果工作表
    On Error Resume Next
    Set wsResult = ThisWorkbook.Worksheets("汇总表")
    If Err.Number <> 0 Then
        Set wsResult = ThisWorkbook.Worksheets.Add(After:=wsSource)
        wsResult.Name = "汇总表"
    End If
    On Error GoTo 0
    
    ' 初始化字典用于计数
    Set sceneDict = CreateObject("Scripting.Dictionary")
    
    ' 获取原始数据最后一行行数
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历每一行数据
    For i = 2 To lastRow
        ' 提取当前行所有非空用餐场景（B、C列）
        ReDim scenes(0 To 0)
        For j = 2 To 3
            If wsSource.Cells(i, j).Value <> "" Then
                scenes(UBound(scenes)) = wsSource.Cells(i, j).Value
                ReDim Preserve scenes(UBound(scenes) + 1)
            End If
        Next j
        ReDim Preserve scenes(UBound(scenes) - 1)
        
        ' 提取当前行所有非空食材（D、E、F列）
        ReDim foods(0 To 0)
        For j = 4 To 6
            If wsSource.Cells(i, j).Value <> "" Then
                foods(UBound(foods)) = wsSource.Cells(i, j).Value
                ReDim Preserve foods(UBound(foods) + 1)
            End If
        Next j
        ReDim Preserve foods(UBound(foods) - 1)
        
        ' 更新场景-食材的计数
        For Each scene In scenes
            If Not sceneDict.Exists(scene) Then
                Set foodDict = CreateObject("Scripting.Dictionary")
                sceneDict(scene) = foodDict
            End If
            Set foodDict = sceneDict(scene)
            For Each food In foods
                If foodDict.Exists(food) Then
                    foodDict(food) = foodDict(food) + 1
                Else
                    foodDict(food) = 1
                End If
            Next food
        Next scene
    Next i
    
    ' 生成汇总表表头（收集所有食材并去重）
    Dim allFoods As Collection, foodItem As Variant
    Set allFoods = New Collection
    For Each scene In sceneDict.Keys
        Set foodDict = sceneDict(scene)
        For Each food In foodDict.Keys
            On Error Resume Next
            allFoods.Add food, Key:=food
            On Error GoTo 0
        Next food
    Next scene
    wsResult.Cells(1, 1).Value = ""
    For k = 1 To allFoods.Count
        wsResult.Cells(1, k + 1).Value = allFoods(k)
    Next k
    
    ' 写入各场景的食材计数
    Dim rowNum As Long: rowNum = 2
    For Each scene In sceneDict.Keys
        wsResult.Cells(rowNum, 1).Value = scene
        Set foodDict = sceneDict(scene)
        For k = 1 To allFoods.Count
            food = allFoods(k)
            wsResult.Cells(rowNum, k + 1).Value = IIf(foodDict.Exists(food), foodDict(food), "")
        Next k
        rowNum = rowNum + 1
    Next scene
    
    ' 自动调整列宽
    wsResult.UsedRange.Columns.AutoFit
    
    MsgBox "汇总完成！"
End Sub

4. 修改代码中Set wsSource = ThisWorkbook.Worksheets("Sheet1")的Sheet1为你的原始数据所在工作表名称。
5. 按下F5运行代码，会自动生成名为“汇总表”的工作表，输出你需要的统计结果。

Markdown原生不支持单元格颜色设置，在Stack Exchange平台可通过以下方式实现：

• 直接编写HTML表格，在<td>或<th>标签中添加style属性指定颜色，示例：

<table>
  <tr>
    <th style="background-color: #f0f0f0;">场景</th>
    <td style="background-color: #ffebee;">鸡蛋</td>
  </tr>
</table>

• 若从Excel复制带颜色的表格，可先复制到本地Word，导出为HTML后提取对应表格代码，再粘贴到提问编辑器中，保留style属性即可。

内容的提问来源于stack exchange，提问作者AndBB