AutoBOM/VBA/Modules/BIPUploadModule.bas

'=====================================================================
' 模块名: BIPUploadModule
' 功能: 处理产品订单数据，提取BOM后生成[BIP上传模板]格式数据
'=====================================================================

Option Explicit

'=====================================================================
' 常量定义
'=====================================================================
' 提取条件配置
Private Const CONDITION_CONFIG = "azxs，安装形式 |bkxs，表壳形式 |gclj，过程连接 |jycz，接液材质 |lcfw，量程范围 |fjgn，附加功能"

'=====================================================================
' 过程: ProcessOrdersToBIP
' 功能: 处理产品订单数据，生成BIP上传格式
' 说明: 主入口程序，从[产品订单]读取数据，输出到[BIP上传模板]
'=====================================================================
Public Sub ProcessOrdersToBIP()
    On Error GoTo ErrorHandler

    Dim startTime As Double
    startTime = Timer

    ' 准备工作表对象
    Dim orderSheet As Worksheet
    Dim bipSheet As Worksheet
    Dim bomSheet As Worksheet

    ' 获取[产品订单]工作表
    Set orderSheet = GetOrderSheet()
    If orderSheet Is Nothing Then
        MsgBox "未找到[产品订单]工作表!", vbCritical
        Exit Sub
    End If

    ' 获取[BIP上传模板]工作表
    Set bipSheet = GetBIPUploadSheet()

    ' 获取BOM库工作表
    Set bomSheet = GetBomSheet()
    If bomSheet Is Nothing Then
        MsgBox "未找到[平台配置清单]工作表!", vbCritical
        Exit Sub
    End If

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

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

    ' 清空BIP上传模板数据（保留表头）
    ClearBIPSheetData bipSheet

    ' 写入BIP上传模板表头
    WriteBIPHeader bipSheet

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

    ' 如果只有表头或没有数据
    If lastRow < 2 Then
        MsgBox "[产品订单]工作表中没有数据!", vbExclamation
        Exit Sub
    End If

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

    Dim i As Long
    Dim processedCount As Long
    Dim orderCount As Long

    processedCount = 0
    orderCount = 0

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

        ' --- 核心修改：调整列索引以适应新增的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
            GoTo ContinueLoop
        End If

        ' 验证必填字段
        If orderNumber = "" Then
            MsgBox "第" & i & "行：生产订单号为空，跳过该行!", vbExclamation
            GoTo ContinueLoop
        End If

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

        If Quantity = "" Then
            MsgBox "第" & i & "行：数量为空，跳过该行!", vbExclamation
            GoTo ContinueLoop
        End If

        orderCount = orderCount + 1

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

ContinueLoop:
    Next i

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

    ' 格式化BIP上传模板
    FormatBIPSheet bipSheet

    Dim elapsedTime As Double
    elapsedTime = Timer - startTime

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

    ' 激活BIP上传模板
    bipSheet.Activate

    Exit Sub

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

'=====================================================================
' 过程: ProcessSingleOrder
' 功能: 处理单个订单，提取BOM并将数据添加到输出集合
' 参数: orderNumber - 生产订单号
'       productModel - 产品型号
'       quantity - 生产数量
'       productCode - 产品编码
'       componentPriority - 部件优先标志（"是"或"否"）
'       BomExtractor - BOM提取器对象
'       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)
    On Error Resume Next

    ' 根据部件优先设置排除类别
    BomExtractor.ClearExcludeCategories
    If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then
        Dim excludeCats As New Collection
        excludeCats.Add "部件"
        BomExtractor.SetExcludeCategories excludeCats
    End If

    ' 解析产品型号
    Dim parser As ProductModelParser
    Set parser = New ProductModelParser

    Dim extractNote As String
    extractNote = ""

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

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

    ' 获取错误信息
    Dim bomErrors As String
    bomErrors = BomExtractor.GetErrorSummary
    If bomErrors <> "" Then
        extractNote = bomErrors
    End If

    ' 输出结果
    If matchedItems.count = 0 Then
        ' 没有匹配项，添加一行空记录
        If extractNote = "" Then
            extractNote = "未匹配到任何物料"
        End If
        outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote)
    Else
        ' 输出每个匹配的物料
        Dim item As BomItem
        Dim lineIndex As Long
        lineIndex = 1

        ' 创建字典跟踪每个 BIP 行号基数的当前序号
        Dim bipRowBaseDict As Object
        Set bipRowBaseDict = CreateObject("Scripting.Dictionary")

        For Each item In matchedItems
            Dim itemNote As String
            itemNote = extractNote

            ' 添加物料特定的错误
            If item.MatchError <> "" Then
                If itemNote <> "" Then itemNote = itemNote & "; "
                itemNote = itemNote & item.MatchError
            End If

            ' 计算实际行号：行号 = BIP 行号基数 + 组内序号 (从 1 开始)
            Dim baseValue As Long
            baseValue = item.BipRowNumberBase

            Dim currentIndex As Long
            If bipRowBaseDict.Exists(baseValue) Then
                currentIndex = bipRowBaseDict(baseValue) + 1
            Else
                currentIndex = 1
            End If
            bipRowBaseDict(baseValue) = currentIndex

            Dim actualRowNumber As Long
            actualRowNumber = baseValue + currentIndex

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

            lineIndex = lineIndex + 1
        Next item
    End If
End Sub

'=====================================================================
' 函数：CreateBIPRowArray
' 功能：创建 BIP 上传模板一行数据的数组
' 参数：orderNumber - 生产订单号
'       productCode - 产品编码
'       quantity - 生产数量
'       actualRowNumber - 实际行号（BIP 行号基数 + 组内序号）
'       materialCode - 材料编码（66 编码）
'       note - 备注
' 返回：Variant() - 包含 10 个元素的数组
'=====================================================================
Private Function CreateBIPRowArray(orderNumber As String, _
                                  productCode As String, _
                                  Quantity As String, _
                                  actualRowNumber As Long, _
                                  materialCode As String, _
                                  note As String) As Variant()
    Dim rowData(1 To 10) As Variant

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

    CreateBIPRowArray = rowData
End Function

'=====================================================================
' 过程: WriteBatchData
' 功能: 批量写入数据到工作表
' 参数: ws - 工作表对象
'       outputData - 输出数据集合，每个元素是一个一维数组
'=====================================================================
Private Sub WriteBatchData(ws As Worksheet, outputData As Collection)
    ' 如果没有数据，直接返回
    If outputData.count = 0 Then
        Exit Sub
    End If

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

    Dim resultData() As Variant
    ReDim resultData(1 To rowCount, 1 To 10)

    ' 填充数据到二维数组
    Dim i As Long
    Dim rowArray As Variant

    For i = 1 To rowCount
        rowArray = outputData(i)

        resultData(i, 1) = rowArray(1)
        resultData(i, 2) = rowArray(2)
        resultData(i, 3) = rowArray(3)
        resultData(i, 4) = rowArray(4)
        resultData(i, 5) = rowArray(5)
        resultData(i, 6) = rowArray(6)
        resultData(i, 7) = rowArray(7)
        resultData(i, 8) = rowArray(8)
        resultData(i, 9) = rowArray(9)
        resultData(i, 10) = rowArray(10)
    Next i

    ' 一次性写入工作表（从第2行开始）
    ws.Range("A2").Resize(rowCount, 10).value = resultData
End Sub

'=====================================================================
' 过程: WriteBIPHeader
' 功能: 写入BIP上传模板表头
' 参数: ws - 工作表对象
'=====================================================================
Private Sub WriteBIPHeader(ws As Worksheet)
    ' 第1行：主表头
    ws.Cells(1, 1).value = "来源单据号（生产订单号）"
    ws.Cells(1, 2).value = "产品编码"
    ws.Cells(1, 3).value = "生产数量"
    ws.Cells(1, 4).value = "行号"
    ws.Cells(1, 5).value = "材料编码"
    ws.Cells(1, 6).value = "供应方式"
    ws.Cells(1, 7).value = "需用日期"
    ws.Cells(1, 8).value = "发料组织"
    ws.Cells(1, 9).value = "计划出库数量"
    ws.Cells(1, 10).value = "备注"
End Sub

'=====================================================================
' 函数: GetOrderSheet
' 功能: 获取[产品订单]工作表
' 返回: Worksheet - 工作表对象
'=====================================================================
Private Function GetOrderSheet() As Worksheet
    On Error Resume Next
    Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单")
    On Error GoTo 0
End Function

'=====================================================================
' 函数: GetBIPUploadSheet
' 功能: 获取或创建[BIP上传模板]工作表
' 返回: Worksheet - 工作表对象
'=====================================================================
Private Function GetBIPUploadSheet() As Worksheet
    Dim wsName As String
    wsName = "BIP上传模板"

    On Error Resume Next
    Set GetBIPUploadSheet = ThisWorkbook.Worksheets(wsName)
    On Error GoTo 0

    If GetBIPUploadSheet Is Nothing Then
        ' 创建新工作表
        Set GetBIPUploadSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.count))
        GetBIPUploadSheet.Name = wsName
    End If
End Function

'=====================================================================
' 函数: GetBomSheet
' 功能: 获取BOM工作表
' 返回: Worksheet - BOM工作表对象
'=====================================================================
Private Function GetBomSheet() As Worksheet
    On Error Resume Next
    Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单")
    On Error GoTo 0
End Function

'=====================================================================
' 过程: ClearBIPSheetData
' 功能: 清空BIP上传模板的数据（保留表头）
' 参数: ws - 工作表对象
'=====================================================================
Private Sub ClearBIPSheetData(ws As Worksheet)
    ' 清空从第2行开始的所有数据
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row

    If lastRow > 1 Then
        ws.Rows("2:" & lastRow).ClearContents
    End If
End Sub

'=====================================================================
' 过程: FormatBIPSheet
' 功能: 格式化BIP上传模板工作表
' 参数: ws - 工作表对象
'=====================================================================
Private Sub FormatBIPSheet(ws As Worksheet)
    On Error Resume Next

    ' 设置表头格式
    With ws.Rows(1)
        .Font.Bold = True
        .Interior.Color = RGB(217, 217, 217)
        .HorizontalAlignment = xlCenter
    End With

    ' 设置所有单元格居中对齐
    With ws.UsedRange
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    ' 自动调整列宽
    ws.Columns.AutoFit

    ' 设置日期列格式
    ws.Columns(7).NumberFormat = "yyyy/mm/dd"

    On Error GoTo 0
End Sub