寻找共用子组件更多的成品，求VBA/数据透视表优化算法

针对你提到的成品-子组件对应关系，我整理了两种能帮你优化生产的方案，分别适合快速分析和自动化深度优化的场景：

一、数据透视表方案（零代码快速洞察） #

如果你需要快速梳理成品与组件的关联、找到生产优化的方向，数据透视表是最直接的工具：

步骤1：整理结构化数据 #

先把你的数据整理成两列的表格格式（比如放在Excel的A-B列）：

步骤2：创建分析用透视表 #

选中数据区域，插入数据透视表，按以下配置设置：

• 行区域：拖入「成品」字段
• 列区域：拖入「子组件」字段
• 值区域：拖入「子组件」字段，然后修改值显示方式为「计数」（或者用「自定义格式」把非零值标记为"√"，更直观）

步骤3：基于透视表优化生产 #

从透视表你可以得到这些关键信息：

• 共享组件最多的成品组：比如A和C共享3个组件（1、2、4），A和D共享2个（1、4），可以把这些成品安排在同一生产批次，减少组件切换次数
• 高需求组件：组件1被所有成品使用，组件4被A、C、D使用，这些组件可以提前批量备货，避免生产中断
• 独特组件：组件3只被B使用，组件5被A、B使用，可以针对性安排这些组件的生产或采购

二、VBA算法方案（自动化批量优化） #

如果需要自动计算最优生产分组、或者频繁更新数据后快速得到优化建议，可以用VBA脚本实现自动化分析。以下是一个针对你的场景编写的宏：

功能说明 #

这个宏会：

1. 读取成品与子组件的对应关系
2. 计算每对成品之间的组件重叠度
3. 输出最优生产分组（优先组合重叠度最高的成品）
4. 统计每个组件的使用频次

VBA代码实现 #

打开Excel，按下Alt+F11打开VBA编辑器，插入新模块，粘贴以下代码：

Sub OptimizeProduction()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim prodComponents As Object ' 存储每个成品的组件集合
    Dim prodList As Variant
    Dim i As Integer, j As Integer
    Dim overlapCount As Integer
    Dim maxOverlap As Integer
    Dim groupedProds As String
    Dim componentUsage As Object ' 统计组件使用次数
    
    ' 设置工作表（假设数据在Sheet1，可根据实际修改）
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 初始化字典存储成品-组件映射
    Set prodComponents = CreateObject("Scripting.Dictionary")
    Set componentUsage = CreateObject("Scripting.Dictionary")
    
    ' 读取数据到字典
    For i = 2 To lastRow ' 假设第一行是表头
        Dim prod As String, comp As String
        prod = ws.Cells(i, "A").Value
        comp = ws.Cells(i, "B").Value
        
        ' 存储成品的组件集合
        If Not prodComponents.Exists(prod) Then
            prodComponents.Add prod, CreateObject("Scripting.Dictionary")
        End If
        prodComponents(prod).Add comp, True
        
        ' 统计组件使用次数
        If componentUsage.Exists(comp) Then
            componentUsage(comp) = componentUsage(comp) + 1
        Else
            componentUsage.Add comp, 1
        End If
    Next i
    
    ' 获取成品列表
    prodList = prodComponents.Keys
    
    ' 计算成品间的组件重叠度，输出最优分组
    Debug.Print "=== 最优生产分组建议 ==="
    Dim usedProds As Object
    Set usedProds = CreateObject("Scripting.Dictionary")
    
    For i = 0 To UBound(prodList)
        If Not usedProds.Exists(prodList(i)) Then
            maxOverlap = 0
            groupedProds = prodList(i)
            usedProds.Add prodList(i), True
            
            ' 寻找重叠度最高的未分组成品
            For j = 0 To UBound(prodList)
                If Not usedProds.Exists(prodList(j)) And prodList(j) <> prodList(i) Then
                    overlapCount = 0
                    ' 统计共同组件数量
                    For Each comp In prodComponents(prodList(i)).Keys
                        If prodComponents(prodList(j)).Exists(comp) Then
                            overlapCount = overlapCount + 1
                        End If
                    Next comp
                    
                    ' 如果当前重叠度最高，加入分组
                    If overlapCount > maxOverlap Then
                        maxOverlap = overlapCount
                        groupedProds = groupedProds & ", " & prodList(j)
                        usedProds.Add prodList(j), True
                    End If
                End If
            Next j
            
            Debug.Print "分组：" & groupedProds & "（共享" & maxOverlap & "个组件）"
        End If
    Next i
    
    ' 输出组件使用频次
    Debug.Print vbNewLine & "=== 组件使用频次统计 ==="
    For Each comp In componentUsage.Keys
        Debug.Print "组件" & comp & "：被" & componentUsage(comp) & "个成品使用"
    Next comp
    
    MsgBox "生产优化分析已完成，请查看立即窗口（Ctrl+G）获取结果！"
End Sub

使用说明 #

1. 确保你的数据在Sheet1的A-B列（A列成品，B列子组件），第一行是表头
2. 运行宏后，按下Ctrl+G打开立即窗口，就能看到最优分组建议和组件使用统计
3. 你可以根据实际需求修改代码，比如调整分组逻辑、输出结果到工作表而非立即窗口

内容的提问来源于stack exchange，提问作者Adrián López de Toro