feat: add Access data integration and total queue number column

- Add new AccessDataModule for fetching data from Access database based on total queue number - Add CommandButton3_Click handler in Sheet9 for Access data fetch - Add support for new "总排号" (Total Queue Number) column at column A - Adjust all column indices to accommodate the new column (shifted by +1) - Standardize code style: Collection, Count, Quantity, ProductModel, Description - Fix inventory check result to write to correct column (F instead of E) Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-12 13:53:28 +08:00
parent 787b3f56ab
commit 1747af046b
9 changed files with 343 additions and 145 deletions
--- a/VBA/Modules/AccessDataModule.bas
+++ b/VBA/Modules/AccessDataModule.bas
@@ -0,0 +1,174 @@
+'=====================================================================
+' 模块名: AccessDataModule
+' 功能: 连接Access数据库，根据[总排号]提取数据并填充到[产品订单]工作表
+'=====================================================================
+
+Option Explicit
+
+'=====================================================================
+' 配置区域 (请根据你的实际情况修改以下常量)
+'=====================================================================
+' Access数据库文件的完整路径
+Private Const DB_PATH = "\\192.168.110.114\生产进度表\2025年数据\生产合同数据.accdb"
+' Access中目标数据表的名称
+Private Const TARGET_TABLE = "26年压力表合同数据"
+
+'=====================================================================
+' 过程: FetchDataFromAccess
+' 功能: 主控程序，执行数据提取和回填逻辑
+'=====================================================================
+Public Sub FetchDataFromAccess()
+    On Error GoTo ErrorHandler
+
+    Dim startTime As Double
+    startTime = Timer
+
+    Dim ws As Worksheet
+    Set ws = GetOrderSheet()
+    If ws Is Nothing Then
+        MsgBox "未找到[产品订单]工作表，请检查工作表名称。", vbCritical
+        Exit Sub
+    End If
+
+    Dim lastRow As Long
+    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row
+
+    If lastRow < 2 Then
+        MsgBox "[产品订单]工作表中没有需要处理的数据。", vbInformation
+        Exit Sub
+    End If
+
+    ' 1. 将Excel数据读入内存数组 (A到F列)
+    Dim dataArr As Variant
+    dataArr = ws.Range("A2:F" & lastRow).value
+
+    ' 收集所有的总排号，用于构建SQL查询条件
+    Dim queueNums As String
+    Dim i As Long
+    Dim currentNum As String
+
+    For i = 1 To UBound(dataArr, 1)
+        currentNum = Trim(dataArr(i, 1))
+        If currentNum <> "" Then
+            ' 假设总排号是文本类型。如果是纯数字类型，请去掉单引号
+            queueNums = queueNums & "'" & currentNum & "',"
+        End If
+    Next i
+
+    If queueNums = "" Then
+        MsgBox "没有找到有效的总排号。", vbInformation
+        Exit Sub
+    End If
+
+    ' 去除最后一个逗号
+    queueNums = Left(queueNums, Len(queueNums) - 1)
+
+    ' 2. 连接Access数据库并查询
+    Dim cn As Object
+    Dim rs As Object
+    Set cn = CreateObject("ADODB.Connection")
+    Set rs = CreateObject("ADODB.Recordset")
+
+    ' 构建连接字符串 (适用于 .accdb 格式)
+    Dim connStr As String
+    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DB_PATH & ";"
+
+    cn.Open connStr
+
+    ' 构建SQL语句，只提取需要的字段和匹配的总排号
+    Dim sql As String
+    sql = "SELECT 总排号, 生产订单号, 产品型号, 数量, 成品物料码 " & _
+          "FROM [" & TARGET_TABLE & "] " & _
+          "WHERE 总排号 IN (" & queueNums & ")"
+
+    rs.Open sql, cn, 1, 1 ' adOpenKeyset, adLockReadOnly
+
+    ' 3. 将查询结果存入字典，利用字典的哈希特性实现极速匹配
+    Dim dbDict As Object
+    Set dbDict = CreateObject("Scripting.Dictionary")
+
+    If Not rs.EOF Then
+        rs.MoveFirst
+        Do Until rs.EOF
+            Dim key As String
+            key = Trim(rs.Fields("总排号").value)
+
+            ' 将需要的字段打包成一个数组存入字典
+            If Not dbDict.Exists(key) Then
+                dbDict.Add key, Array( _
+                    rs.Fields("生产订单号").value, _
+                    rs.Fields("产品型号").value, _
+                    rs.Fields("数量").value, _
+                    rs.Fields("成品物料码").value _
+                )
+            End If
+            rs.MoveNext
+        Loop
+    End If
+
+    ' 关闭数据库连接
+    rs.Close
+    cn.Close
+    Set rs = Nothing
+    Set cn = Nothing
+
+    ' 4. 将字典中的数据回填到内存数组
+    Dim matchCount As Long
+    matchCount = 0
+
+    For i = 1 To UBound(dataArr, 1)
+        currentNum = Trim(dataArr(i, 1))
+        If dbDict.Exists(currentNum) Then
+            Dim dbRecord As Variant
+            dbRecord = dbDict(currentNum)
+
+            ' 将对应的字段映射到数组的相应列
+            dataArr(i, 2) = dbRecord(0) ' B列: 生产订单号
+            dataArr(i, 3) = dbRecord(1) ' C列: 产品型号
+            dataArr(i, 4) = dbRecord(2) ' D列: 数量
+            dataArr(i, 5) = dbRecord(3) ' E列: 产品编码 (成品物料码)
+            ' F列 (部件优先) 保持原样，不作修改
+
+            matchCount = matchCount + 1
+        End If
+    Next i
+
+    ' 5. 将更新后的数组一次性写回工作表
+    ws.Range("A2:F" & lastRow).value = dataArr
+
+    ' 清理内存
+    Set dbDict = Nothing
+
+    Dim elapsedTime As Double
+    elapsedTime = Timer - startTime
+
+    MsgBox "数据提取完成!" & vbCrLf & _
+           "成功匹配并更新了 " & matchCount & " 条记录。" & vbCrLf & _
+           "用时: " & Format(elapsedTime, "0.00") & " 秒", vbInformation
+
+    Exit Sub
+
+ErrorHandler:
+    ' 确保发生错误时关闭数据库连接
+    On Error Resume Next
+    If Not rs Is Nothing Then
+        If rs.State = 1 Then rs.Close
+    End If
+    If Not cn Is Nothing Then
+        If cn.State = 1 Then cn.Close
+    End If
+    On Error GoTo 0
+
+    MsgBox "提取Access数据时发生异常: " & Err.Description, vbCritical
+End Sub
+
+'=====================================================================
+' 函数: GetOrderSheet
+' 功能: 获取[产品订单]工作表
+' 返回: Worksheet - 工作表对象
+'=====================================================================
+Private Function GetOrderSheet() As Worksheet
+    On Error Resume Next
+    Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单")
+    On Error GoTo 0
+End Function
--- a/VBA/Modules/BIPUploadModule.bas
+++ b/VBA/Modules/BIPUploadModule.bas
@@ -64,7 +64,7 @@ Public Sub ProcessOrdersToBIP()

    ' 获取订单数据行数
    Dim lastRow As Long
-    lastRow = orderSheet.Cells(orderSheet.Rows.Count, 1).End(xlUp).row
+    lastRow = orderSheet.Cells(orderSheet.Rows.count, 1).End(xlUp).row

    ' 如果只有表头或没有数据
    If lastRow < 2 Then
@@ -73,8 +73,8 @@ Public Sub ProcessOrdersToBIP()
    End If

    ' 处理每个订单，收集所有输出数据
-    Dim outputData As collection
-    Set outputData = New collection
+    Dim outputData As Collection
+    Set outputData = New Collection

    Dim i As Long
    Dim processedCount As Long
@@ -85,20 +85,23 @@ Public Sub ProcessOrdersToBIP()

    For i = 2 To lastRow
        ' 读取订单数据
+        Dim totalQueueNum As String
        Dim orderNumber As String
-        Dim productModel As String
-        Dim quantity As String
+        Dim ProductModel As String
+        Dim Quantity As String
        Dim productCode As String
        Dim componentPriority As String

-        orderNumber = Trim(orderSheet.Cells(i, 1).value)      ' A列：生产订单号
-        productModel = Trim(orderSheet.Cells(i, 2).value)     ' B列：产品型号
-        quantity = Trim(orderSheet.Cells(i, 3).value)         ' C列：数量
-        productCode = Trim(orderSheet.Cells(i, 4).value)      ' D列：产品编码
-        componentPriority = Trim(orderSheet.Cells(i, 5).value) ' E列：部件优先
+        ' --- 核心修改：调整列索引以适应新增的A列“总排号” ---
+        totalQueueNum = Trim(orderSheet.Cells(i, 1).value)     ' A列：总排号 (如果后续BIP需要可直接使用此变量)
+        orderNumber = Trim(orderSheet.Cells(i, 2).value)       ' B列：生产订单号
+        ProductModel = Trim(orderSheet.Cells(i, 3).value)      ' C列：产品型号
+        Quantity = Trim(orderSheet.Cells(i, 4).value)          ' D列：数量
+        productCode = Trim(orderSheet.Cells(i, 5).value)       ' E列：产品编码
+        componentPriority = Trim(orderSheet.Cells(i, 6).value) ' F列：部件优先

        ' 跳过空行
-        If orderNumber = "" And productModel = "" Then
+        If orderNumber = "" And ProductModel = "" Then
            GoTo ContinueLoop
        End If

@@ -108,12 +111,12 @@ Public Sub ProcessOrdersToBIP()
            GoTo ContinueLoop
        End If

-        If productModel = "" Then
+        If ProductModel = "" Then
            MsgBox "第" & i & "行：产品型号为空，跳过该行!", vbExclamation
            GoTo ContinueLoop
        End If

-        If quantity = "" Then
+        If Quantity = "" Then
            MsgBox "第" & i & "行：数量为空，跳过该行!", vbExclamation
            GoTo ContinueLoop
        End If
@@ -121,7 +124,7 @@ Public Sub ProcessOrdersToBIP()
        orderCount = orderCount + 1

        ' 处理单个订单，收集输出数据
-        ProcessSingleOrder orderNumber, productModel, quantity, productCode, _
+        ProcessSingleOrder orderNumber, ProductModel, Quantity, productCode, _
                          componentPriority, BomExtractor, outputData
        processedCount = processedCount + 1

@@ -129,7 +132,7 @@ ContinueLoop:
    Next i

    ' 批量写入数据到工作表
-    If outputData.Count > 0 Then
+    If outputData.count > 0 Then
        WriteBatchData bipSheet, outputData
    End If

@@ -141,7 +144,7 @@ ContinueLoop:

    MsgBox "处理完成!" & vbCrLf & _
           "处理订单数: " & orderCount & vbCrLf & _
-           "生成BIP行数: " & outputData.Count & vbCrLf & _
+           "生成BIP行数: " & outputData.count & vbCrLf & _
           "用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation

    ' 激活BIP上传模板
@@ -150,7 +153,7 @@ ContinueLoop:
    Exit Sub

 ErrorHandler:
-    MsgBox "处理异常: " & Err.description, vbCritical
+    MsgBox "处理异常: " & Err.Description, vbCritical
 End Sub

 '=====================================================================
@@ -165,18 +168,18 @@ End Sub
 '       outputData - 输出数据集合
 '=====================================================================
 Private Sub ProcessSingleOrder(orderNumber As String, _
-                              productModel As String, _
-                              quantity As String, _
-                              productCode As String, _
-                              componentPriority As String, _
-                              BomExtractor As BomExtractor, _
-                              outputData As collection)
+                               ProductModel As String, _
+                               Quantity As String, _
+                               productCode As String, _
+                               componentPriority As String, _
+                               BomExtractor As BomExtractor, _
+                               outputData As Collection)
    On Error Resume Next

    ' 根据部件优先设置排除类别
    BomExtractor.ClearExcludeCategories
    If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then
-        Dim excludeCats As New collection
+        Dim excludeCats As New Collection
        excludeCats.Add "部件"
        BomExtractor.SetExcludeCategories excludeCats
    End If
@@ -188,15 +191,15 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
    Dim extractNote As String
    extractNote = ""

-    If Not parser.Parse(productModel) Then
+    If Not parser.Parse(ProductModel) Then
        ' 解析失败，添加一行错误记录
        extractNote = "解析失败: " & parser.ErrorMessage
-        outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote)
+        outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote)
        Exit Sub
    End If

    ' 提取BOM
-    Dim matchedItems As collection
+    Dim matchedItems As Collection
    Set matchedItems = BomExtractor.ExtractBom(parser.Conditions)

    ' 获取错误信息
@@ -207,12 +210,12 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
    End If

    ' 输出结果
-    If matchedItems.Count = 0 Then
+    If matchedItems.count = 0 Then
        ' 没有匹配项，添加一行空记录
        If extractNote = "" Then
            extractNote = "未匹配到任何物料"
        End If
-        outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote)
+        outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote)
    Else
        ' 输出每个匹配的物料
        Dim item As BomItem
@@ -230,7 +233,7 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
            End If

            ' 创建BIP行数据并添加到集合
-            outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, _
+            outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, _
                                            lineIndex, item.Code66, itemNote)

            lineIndex = lineIndex + 1
@@ -251,7 +254,7 @@ End Sub
 '=====================================================================
 Private Function CreateBIPRowArray(orderNumber As String, _
                                  productCode As String, _
-                                  quantity As String, _
+                                  Quantity As String, _
                                  lineIndex As Long, _
                                  materialCode As String, _
                                  note As String) As Variant()
@@ -259,13 +262,13 @@ Private Function CreateBIPRowArray(orderNumber As String, _

    rowData(1) = orderNumber                                    ' 来源单据号（生产订单号）
    rowData(2) = productCode                                    ' 产品编码
-    rowData(3) = quantity                                       ' 生产数量
+    rowData(3) = Quantity                                       ' 生产数量
    rowData(4) = ROW_NUMBER_BASE + lineIndex                    ' 行号 = 基数 + 索引
    rowData(5) = materialCode                                   ' 材料编码（66编码）
    rowData(6) = "一般发料"                                     ' 供应方式（固定值）
    rowData(7) = Date                                           ' 需用日期（当天日期）
-    rowData(8) = "重庆布莱迪仪器仪表有限公司"                   ' 发料组织（固定值）
-    rowData(9) = quantity                                       ' 计划出库数量（与生产数量一致）
+    rowData(8) = "重庆布莱迪仪器仪表有限公司"                    ' 发料组织（固定值）
+    rowData(9) = Quantity                                       ' 计划出库数量（与生产数量一致）
    rowData(10) = note                                          ' 备注

    CreateBIPRowArray = rowData
@@ -277,15 +280,15 @@ End Function
 ' 参数: ws - 工作表对象
 '       outputData - 输出数据集合，每个元素是一个一维数组
 '=====================================================================
-Private Sub WriteBatchData(ws As Worksheet, outputData As collection)
+Private Sub WriteBatchData(ws As Worksheet, outputData As Collection)
    ' 如果没有数据，直接返回
-    If outputData.Count = 0 Then
+    If outputData.count = 0 Then
        Exit Sub
    End If

    ' 创建二维数组
    Dim rowCount As Long
-    rowCount = outputData.Count
+    rowCount = outputData.count

    Dim resultData() As Variant
    ReDim resultData(1 To rowCount, 1 To 10)
@@ -358,7 +361,7 @@ Private Function GetBIPUploadSheet() As Worksheet

    If GetBIPUploadSheet Is Nothing Then
        ' 创建新工作表
-        Set GetBIPUploadSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
+        Set GetBIPUploadSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.count))
        GetBIPUploadSheet.Name = wsName
    End If
 End Function
@@ -382,7 +385,7 @@ End Function
 Private Sub ClearBIPSheetData(ws As Worksheet)
    ' 清空从第2行开始的所有数据
    Dim lastRow As Long
-    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
+    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row

    If lastRow > 1 Then
        ws.Rows("2:" & lastRow).ClearContents
--- a/VBA/Modules/ComponentInventoryCheckModule.bas
+++ b/VBA/Modules/ComponentInventoryCheckModule.bas
@@ -66,21 +66,21 @@ Public Sub CheckComponentInventory()
        Exit Sub
    End If

-    ' 检查订单数据
+    ' 检查订单数据 (调整为按C列:产品型号获取最后一行)
    Dim lastRow As Long
-    lastRow = orderSheet.Cells(orderSheet.Rows.Count, 2).End(xlUp).Row
+    lastRow = orderSheet.Cells(orderSheet.Rows.count, 3).End(xlUp).row
    If lastRow < 2 Then
        MsgBox "[产品订单]工作表没有数据!", vbExclamation
        Exit Sub
    End If

    ' 初始化BOM提取器
-    Dim bomExtractor As BomExtractor
-    Set bomExtractor = New BomExtractor
-    bomExtractor.SetWorksheet bomSheet
+    Dim BomExtractor As BomExtractor
+    Set BomExtractor = New BomExtractor
+    BomExtractor.SetWorksheet bomSheet

-    If Not bomExtractor.LoadBomData Then
-        MsgBox "加载BOM数据失败:" & bomExtractor.GetErrorSummary, vbCritical
+    If Not BomExtractor.LoadBomData Then
+        MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical
        Exit Sub
    End If

@@ -88,7 +88,7 @@ Public Sub CheckComponentInventory()
    Dim inventoryData As Object
    Set inventoryData = LoadInventoryData(inventorySheet)

-    If inventoryData.Count = 0 Then
+    If inventoryData.count = 0 Then
        MsgBox "[现存量]工作表没有有效数据!", vbExclamation
        Exit Sub
    End If
@@ -97,19 +97,19 @@ Public Sub CheckComponentInventory()
    Dim orders As Collection
    Set orders = LoadOrderData(orderSheet)

-    If orders.Count = 0 Then
+    If orders.count = 0 Then
        MsgBox "没有有效的订单数据!", vbExclamation
        Exit Sub
    End If

    ' 解析所有订单的BOM
-    ParseAllOrdersBOM orders, bomExtractor
+    ParseAllOrdersBOM orders, BomExtractor

    ' 统计部件总需求
    Dim componentDemands As Object
    Set componentDemands = CalculateComponentDemand(orders)

-    If componentDemands.Count = 0 Then
+    If componentDemands.count = 0 Then
        MsgBox "没有订单包含'部件'类别物料,无需处理库存!", vbInformation
        Exit Sub
    End If
@@ -138,7 +138,7 @@ Public Sub CheckComponentInventory()
    resultMsg = resultMsg & vbCrLf & "耗时: " & Format(elapsedTime, "0.00") & "秒"

    ' 显示警告信息（如果有）
-    If validationWarnings.Count > 0 Then
+    If validationWarnings.count > 0 Then
        resultMsg = resultMsg & vbCrLf & vbCrLf & "警告信息:" & vbCrLf
        resultMsg = resultMsg & JoinCollection(validationWarnings, vbCrLf)
    End If
@@ -160,16 +160,18 @@ End Sub
 Private Function LoadOrderData(ws As Worksheet) As Collection
    Set LoadOrderData = New Collection

+    ' 调整为按C列获取最后一行
    Dim lastRow As Long
-    lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
+    lastRow = ws.Cells(ws.Rows.count, 3).End(xlUp).row

    Dim i As Long
    For i = 2 To lastRow
        Dim model As String
        Dim qty As Variant

-        model = Trim(ws.Cells(i, 2).Value)  ' B列: 产品型号
-        qty = ws.Cells(i, 3).Value          ' C列: 产品数量
+        ' --- 核心修改：列索引向右移1列 ---
+        model = Trim(ws.Cells(i, 3).value)  ' C列: 产品型号 (原B列)
+        qty = ws.Cells(i, 4).value          ' D列: 产品数量 (原C列)

        ' 跳过空行
        If model <> "" Then
@@ -178,7 +180,7 @@ Private Function LoadOrderData(ws As Worksheet) As Collection

            order.Add ORDER_ROW, CLng(i)
            order.Add ORDER_MODEL, CStr(model)
-            order.Add ORDER_QUANTITY, CDbl(IIf(IsNull(qty), 0, qty))
+            order.Add ORDER_QUANTITY, CDbl(IIf(IsNull(qty) Or IsEmpty(qty), 0, qty))
            order.Add ORDER_COMP_CODE, ""
            order.Add ORDER_COMP_QTY, 0
            order.Add ORDER_HAS_COMP, False
@@ -200,15 +202,15 @@ Private Function LoadInventoryData(ws As Worksheet) As Object

    ' 从第4行开始读取(第3行是表头)
    Dim lastRow As Long
-    lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
+    lastRow = ws.Cells(ws.Rows.count, 2).End(xlUp).row

    Dim i As Long
    For i = 4 To lastRow
        Dim code As String
        Dim qty As Variant

-        code = Trim(ws.Cells(i, 2).Value)  ' B列: 物料编码
-        qty = ws.Cells(i, 10).Value        ' J列: 结存主数量
+        code = Trim(ws.Cells(i, 2).value)  ' B列: 物料编码
+        qty = ws.Cells(i, 10).value        ' J列: 结存主数量

        If code <> "" And Not IsEmpty(qty) Then
            If Not LoadInventoryData.Exists(code) Then
@@ -224,12 +226,12 @@ End Function
 ' 参数: orders - 订单集合(每个元素是字典)
 '       bomExtractor - BOM提取器
 '=====================================================================
-Private Sub ParseAllOrdersBOM(orders As Collection, bomExtractor As BomExtractor)
+Private Sub ParseAllOrdersBOM(orders As Collection, BomExtractor As BomExtractor)
    Dim i As Long
-    For i = 1 To orders.Count
+    For i = 1 To orders.count
        Dim order As Object
        Set order = orders(i)
-        ParseOrderBOM order, bomExtractor
+        ParseOrderBOM order, BomExtractor
    Next i
 End Sub

@@ -239,7 +241,7 @@ End Sub
 ' 参数: orderInfo - 订单信息字典(ByRef)
 '       bomExtractor - BOM提取器
 '=====================================================================
-Private Sub ParseOrderBOM(ByRef orderInfo As Object, bomExtractor As BomExtractor)
+Private Sub ParseOrderBOM(ByRef orderInfo As Object, BomExtractor As BomExtractor)
    On Error Resume Next

    ' 解析型号
@@ -253,14 +255,14 @@ Private Sub ParseOrderBOM(ByRef orderInfo As Object, bomExtractor As BomExtracto

    ' 提取BOM
    Dim matchedItems As Collection
-    Set matchedItems = bomExtractor.ExtractBom(parser.Conditions)
+    Set matchedItems = BomExtractor.ExtractBom(parser.Conditions)

    ' 查找"部件"类别物料
    Dim item As BomItem
    For Each item In matchedItems
        If item.category = "部件" Then
            orderInfo(ORDER_COMP_CODE) = item.Code66
-            orderInfo(ORDER_COMP_QTY) = item.quantity
+            orderInfo(ORDER_COMP_QTY) = item.Quantity
            orderInfo(ORDER_HAS_COMP) = True
            Exit For
        End If
@@ -278,7 +280,7 @@ Private Function CalculateComponentDemand(orders As Collection) As Object
    Set demands = CreateObject("Scripting.Dictionary")

    Dim i As Long
-    For i = 1 To orders.Count
+    For i = 1 To orders.count
        Dim order As Object
        Set order = orders(i)

@@ -355,14 +357,14 @@ Private Sub AllocateInventory(orders As Collection, _
                             ByRef stats As Statistics)

    ' 初始化统计
-    stats.TotalOrders = orders.Count
+    stats.TotalOrders = orders.count
    stats.OrdersWithComponent = 0
    stats.OrdersSufficient = 0
    stats.OrdersInsufficient = 0
    stats.OrdersSkipped = 0

    Dim i As Long
-    For i = 1 To orders.Count
+    For i = 1 To orders.count
        Dim order As Object
        Set order = orders(i)

@@ -400,8 +402,9 @@ Private Sub AllocateInventory(orders As Collection, _
            compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty
            stats.OrdersSufficient = stats.OrdersSufficient + 1
        Else
+            ' --- 核心修改：回填结果写入F列(第6列) ---
            ' 库存不足,标记为"否"
-            orderSheet.Cells(order(ORDER_ROW), 5).Value = "否"
+            orderSheet.Cells(order(ORDER_ROW), 6).value = "否"
            compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty
            stats.OrdersInsufficient = stats.OrdersInsufficient + 1
        End If
@@ -467,4 +470,4 @@ Private Function JoinCollection(coll As Collection, separator As String) As Stri
    Next item

    JoinCollection = result
-End Function
+End Function
--- a/VBA/Modules/MainModule.bas
+++ b/VBA/Modules/MainModule.bas
@@ -56,14 +56,14 @@ Public Sub ProcessProductModels()

    ' 处理每个产品型号
    Dim lastRow As Long
-    lastRow = inputSheet.Cells(inputSheet.Rows.Count, 1).End(xlUp).row
+    lastRow = inputSheet.Cells(inputSheet.Rows.count, 1).End(xlUp).row

    ' 写入输出表头
    WriteOutputHeader outputSheet

    ' 收集所有输出数据
-    Dim outputData As collection
-    Set outputData = New collection
+    Dim outputData As Collection
+    Set outputData = New Collection

    Dim i As Long
    Dim modelString As String
@@ -71,23 +71,27 @@ Public Sub ProcessProductModels()

    processedCount = 0

-    ' 假设产品型号在第1列,从第2行开始
+    ' 假设数据从第2行开始
    For i = 2 To lastRow
+        Dim totalQueueNum As String
        Dim orderNumber As String
-        orderNumber = Trim(inputSheet.Cells(i, 1).value)  ' A列：生产订单号
-        modelString = Trim(inputSheet.Cells(i, 2).value)
        Dim componentPriority As String
-        componentPriority = Trim(inputSheet.Cells(i, 5).value)  ' E列：部件优先
+
+        ' --- 核心修改：调整列索引以适应新增的“总排号” ---
+        totalQueueNum = Trim(inputSheet.Cells(i, 1).value)     ' A列：总排号
+        orderNumber = Trim(inputSheet.Cells(i, 2).value)       ' B列：生产订单号
+        modelString = Trim(inputSheet.Cells(i, 3).value)       ' C列：产品型号
+        componentPriority = Trim(inputSheet.Cells(i, 6).value) ' F列：部件优先 (原E列右移一列)

        If modelString <> "" Then
-            ' 处理单个型号，收集数据
-            ProcessSingleModel orderNumber, modelString, componentPriority, BomExtractor, outputData
+            ' 处理单个型号，收集数据，增加 totalQueueNum 参数
+            ProcessSingleModel totalQueueNum, orderNumber, modelString, componentPriority, BomExtractor, outputData
            processedCount = processedCount + 1
        End If
    Next i

    ' 批量写入数据到工作表
-    If outputData.Count > 0 Then
+    If outputData.count > 0 Then
        WriteBatchData outputSheet, outputData
    End If

@@ -107,7 +111,7 @@ Public Sub ProcessProductModels()
    Exit Sub

 ErrorHandler:
-    MsgBox "处理异常: " & Err.description, vbCritical
+    MsgBox "处理异常: " & Err.Description, vbCritical
 End Sub

 '=====================================================================
@@ -119,17 +123,18 @@ End Sub
 '       bomExtractor - BOM提取器对象
 '       outputData - 输出数据集合
 '=====================================================================
-Private Sub ProcessSingleModel(orderNumber As String, _
-                              modelString As String, _
-                              componentPriority As String, _
-                              BomExtractor As BomExtractor, _
-                              outputData As collection)
+Private Sub ProcessSingleModel(totalQueueNum As String, _
+                               orderNumber As String, _
+                               modelString As String, _
+                               componentPriority As String, _
+                               BomExtractor As BomExtractor, _
+                               outputData As Collection)
    On Error Resume Next

    ' 根据部件优先设置排除类别
    BomExtractor.ClearExcludeCategories
    If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then
-        Dim excludeCats As New collection
+        Dim excludeCats As New Collection
        excludeCats.Add "部件"
        BomExtractor.SetExcludeCategories excludeCats
    End If
@@ -144,12 +149,12 @@ Private Sub ProcessSingleModel(orderNumber As String, _
    If Not parser.Parse(modelString) Then
        ' 解析失败
        extractNote = "解析失败: " & parser.ErrorMessage
-        outputData.Add CreateOutputRowArray(orderNumber, modelString, parser.Conditions, extractNote, Nothing)
+        outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.Conditions, extractNote, Nothing)
        Exit Sub
    End If

    ' 提取BOM
-    Dim matchedItems As collection
+    Dim matchedItems As Collection
    Set matchedItems = BomExtractor.ExtractBom(parser.Conditions)

    ' 获取错误信息
@@ -160,12 +165,12 @@ Private Sub ProcessSingleModel(orderNumber As String, _
    End If

    ' 输出结果
-    If matchedItems.Count = 0 Then
+    If matchedItems.count = 0 Then
        ' 没有匹配项
        If extractNote = "" Then
            extractNote = "未匹配到任何物料"
        End If
-        outputData.Add CreateOutputRowArray(orderNumber, modelString, parser.Conditions, extractNote, Nothing)
+        outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.Conditions, extractNote, Nothing)
    Else
        ' 输出每个匹配的物料
        Dim item As BomItem
@@ -183,10 +188,12 @@ Private Sub ProcessSingleModel(orderNumber As String, _
            End If

            If isFirst Then
-                outputData.Add CreateOutputRowArray(orderNumber, modelString, parser.Conditions, itemNote, item)
+                ' 首行保留总排号和订单号
+                outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.Conditions, itemNote, item)
                isFirst = False
            Else
-                outputData.Add CreateOutputRowArray("", modelString, parser.Conditions, itemNote, item)
+                ' 同一个型号的后续BOM项，总排号和订单号留空以保持报表整洁
+                outputData.Add CreateOutputRowArray("", "", modelString, parser.Conditions, itemNote, item)
            End If
        Next item
    End If
@@ -201,6 +208,8 @@ Private Sub WriteOutputHeader(ws As Worksheet)
    Dim col As Long
    col = 1

+    ' 新增总排号表头
+    ws.Cells(1, col).value = "总排号": col = col + 1
    ws.Cells(1, col).value = "生产订单号": col = col + 1
    ws.Cells(1, col).value = "产品型号": col = col + 1

@@ -236,19 +245,20 @@ End Sub
 '       item - BOM项(可为Nothing)
 ' 返回: Variant() - 行数据数组
 '=====================================================================
-Private Function CreateOutputRowArray(orderNumber As String, _
-                                    FullModel As String, _
-                                    Conditions As Object, _
-                                    note As String, _
-                                    item As BomItem) As Variant()
+Private Function CreateOutputRowArray(totalQueueNum As String, _
+                                      orderNumber As String, _
+                                      FullModel As String, _
+                                      Conditions As Object, _
+                                      note As String, _
+                                      item As BomItem) As Variant()
    ' 获取条件配置
    Dim condNames() As String
    Dim labels() As String
    GetConditionConfig condNames, labels

-    ' 计算总列数：2 + 条件数 + 8
+    ' 计算总列数：3 (排号+订单+型号) + 条件数 + 8 (BOM+备注)
    Dim totalCols As Long
-    totalCols = 2 + (UBound(condNames) - LBound(condNames) + 1) + 8
+    totalCols = 3 + (UBound(condNames) - LBound(condNames) + 1) + 8

    ' 创建数组
    ReDim rowData(1 To totalCols) As Variant
@@ -256,7 +266,8 @@ Private Function CreateOutputRowArray(orderNumber As String, _
    Dim col As Long
    col = 1

-    ' 生产订单号和产品型号
+    ' 基础信息
+    rowData(col) = totalQueueNum: col = col + 1
    rowData(col) = orderNumber: col = col + 1
    rowData(col) = FullModel: col = col + 1

@@ -277,7 +288,7 @@ Private Function CreateOutputRowArray(orderNumber As String, _
        rowData(col) = item.Module: col = col + 1
        rowData(col) = item.code: col = col + 1
        rowData(col) = item.Name: col = col + 1
-        rowData(col) = item.quantity: col = col + 1
+        rowData(col) = item.Quantity: col = col + 1
        rowData(col) = item.category: col = col + 1
        rowData(col) = item.Code66: col = col + 1
    Else
@@ -290,16 +301,15 @@ Private Function CreateOutputRowArray(orderNumber As String, _

    CreateOutputRowArray = rowData
 End Function
-
 '=====================================================================
 ' 过程: WriteBatchData
 ' 功能: 批量写入数据到工作表
 ' 参数: ws - 工作表对象
 '       outputData - 输出数据集合
 '=====================================================================
-Private Sub WriteBatchData(ws As Worksheet, outputData As collection)
+Private Sub WriteBatchData(ws As Worksheet, outputData As Collection)
    ' 如果没有数据，直接返回
-    If outputData.Count = 0 Then
+    If outputData.count = 0 Then
        Exit Sub
    End If

@@ -309,7 +319,7 @@ Private Sub WriteBatchData(ws As Worksheet, outputData As collection)

    Dim rowCount As Long
    Dim colCount As Long
-    rowCount = outputData.Count
+    rowCount = outputData.count
    colCount = UBound(firstRow) - LBound(firstRow) + 1

    ' 创建二维数组
--- a/VBA/Modules/TestModule.bas
+++ b/VBA/Modules/TestModule.bas
@@ -234,12 +234,12 @@ Public Sub TestBomExtractor()
    testConditions.Add "jycz", "1"
    testConditions.Add "lcfw", "M01"

-    Dim matchedItems As collection
+    Dim matchedItems As Collection
    Set matchedItems = extractor.ExtractBom(testConditions)

-    Debug.Print "  匹配到 " & matchedItems.Count & " 个物料"
+    Debug.Print "  匹配到 " & matchedItems.count & " 个物料"

-    If matchedItems.Count > 0 Then
+    If matchedItems.count > 0 Then
        Debug.Print "  匹配的物料:"
        Dim item As BomItem
        Dim i As Long