c7c12838b2
Update MainModule to support component priority field: - Read component priority from column E of [产品订单] worksheet - Pass component priority to ProcessSingleModel function - Apply category exclusion logic based on priority flag: - When "否"/"0"/"FALSE", exclude "部件" category - Only extract sub-category materials when disabled - Consistent with BIPUploadModule implementation Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
383 lines
12 KiB
QBasic
383 lines
12 KiB
QBasic
'=====================================================================
|
||
' 模块名: MainModule
|
||
' 功能: 主控模块,处理产品型号提取和BOM匹配的上层逻辑
|
||
' 作者: Auto-generated
|
||
' 日期: 2025-01-29
|
||
'=====================================================================
|
||
|
||
Option Explicit
|
||
|
||
'=====================================================================
|
||
' 常量定义
|
||
'=====================================================================
|
||
' 提取条件配置(可灵活扩展)
|
||
Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围"
|
||
|
||
'=====================================================================
|
||
' 过程: ProcessProductModels
|
||
' 功能: 批量处理产品型号并输出结果
|
||
' 说明: 这是主入口程序
|
||
'=====================================================================
|
||
Public Sub ProcessProductModels()
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim startTime As Double
|
||
startTime = Timer
|
||
|
||
' 准备输入输出
|
||
Dim inputSheet As Worksheet
|
||
Dim outputSheet As Worksheet
|
||
Dim bomSheet As Worksheet
|
||
|
||
' 获取工作表
|
||
Set inputSheet = GetInputSheet()
|
||
If inputSheet Is Nothing Then
|
||
MsgBox "未找到输入工作表,请确保工作簿中有包含订单数据的工作表", vbCritical
|
||
Exit Sub
|
||
End If
|
||
|
||
' 获取BOM库工作表
|
||
Set bomSheet = GetBomSheet()
|
||
If bomSheet Is Nothing Then
|
||
MsgBox "未找到'平台配置清单'工作表,请确保BOM数据存在", vbCritical
|
||
Exit Sub
|
||
End If
|
||
|
||
' 创建或获取输出工作表
|
||
Set outputSheet = CreateOutputSheet()
|
||
|
||
' 初始化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
|
||
|
||
' 处理每个产品型号
|
||
Dim lastRow As Long
|
||
lastRow = inputSheet.Cells(inputSheet.Rows.Count, 1).End(xlUp).row
|
||
|
||
Dim outputRow As Long
|
||
outputRow = 2 ' 从第2行开始输出(第1行是表头)
|
||
|
||
' 写入输出表头
|
||
WriteOutputHeader outputSheet
|
||
|
||
Dim i As Long
|
||
Dim modelString As String
|
||
Dim processedCount As Long
|
||
|
||
processedCount = 0
|
||
|
||
' 假设产品型号在第1列,从第2行开始
|
||
For i = 2 To lastRow
|
||
modelString = Trim(inputSheet.Cells(i, 2).value)
|
||
Dim componentPriority As String
|
||
componentPriority = Trim(inputSheet.Cells(i, 5).value) ' E列：部件优先
|
||
|
||
If modelString <> "" Then
|
||
' 处理单个型号
|
||
outputRow = ProcessSingleModel(modelString, componentPriority, BomExtractor, outputSheet, outputRow)
|
||
processedCount = processedCount + 1
|
||
End If
|
||
Next i
|
||
|
||
' 格式化输出表
|
||
FormatOutputSheet outputSheet
|
||
|
||
Dim elapsedTime As Double
|
||
elapsedTime = Timer - startTime
|
||
|
||
MsgBox "处理完成!" & vbCrLf & _
|
||
"处理型号数: " & processedCount & vbCrLf & _
|
||
"用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation
|
||
|
||
' 激活输出表
|
||
outputSheet.Activate
|
||
|
||
Exit Sub
|
||
|
||
ErrorHandler:
|
||
MsgBox "处理异常: " & Err.description, vbCritical
|
||
End Sub
|
||
|
||
'=====================================================================
|
||
' 函数: ProcessSingleModel
|
||
' 功能: 处理单个产品型号
|
||
' 参数: modelString - 产品型号字符串
|
||
' componentPriority - 部件优先标志（"是"或"否"）
|
||
' bomExtractor - BOM提取器对象
|
||
' outputSheet - 输出工作表
|
||
' startRow - 起始行号
|
||
' 返回: Long - 下一个可用行号
|
||
'=====================================================================
|
||
Private Function ProcessSingleModel(modelString As String, _
|
||
componentPriority As String, _
|
||
BomExtractor As BomExtractor, _
|
||
outputSheet As Worksheet, _
|
||
startRow As Long) As Long
|
||
On Error Resume Next
|
||
|
||
Dim currentRow As Long
|
||
currentRow = startRow
|
||
|
||
' 根据部件优先设置排除类别
|
||
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(modelString) Then
|
||
' 解析失败
|
||
extractNote = "解析失败: " & parser.ErrorMessage
|
||
WriteOutputRow outputSheet, currentRow, modelString, "", parser.Conditions, extractNote, Nothing
|
||
ProcessSingleModel = currentRow + 1
|
||
Exit Function
|
||
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
|
||
WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, extractNote, Nothing
|
||
currentRow = currentRow + 1
|
||
Else
|
||
' 输出每个匹配的物料
|
||
Dim item As BomItem
|
||
Dim isFirst As Boolean
|
||
isFirst = True
|
||
|
||
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
|
||
|
||
If isFirst Then
|
||
WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, itemNote, item
|
||
isFirst = False
|
||
Else
|
||
WriteOutputRow outputSheet, currentRow, "", "", parser.Conditions, itemNote, item
|
||
End If
|
||
|
||
currentRow = currentRow + 1
|
||
Next item
|
||
End If
|
||
|
||
ProcessSingleModel = currentRow
|
||
End Function
|
||
|
||
'=====================================================================
|
||
' 过程: WriteOutputHeader
|
||
' 功能: 写入输出表头
|
||
' 参数: ws - 工作表对象
|
||
'=====================================================================
|
||
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
|
||
|
||
' 写入条件字段表头
|
||
Dim Conditions() As String
|
||
Dim labels() As String
|
||
GetConditionConfig Conditions, labels
|
||
|
||
Dim i As Long
|
||
For i = LBound(Conditions) To UBound(Conditions)
|
||
ws.Cells(1, col).value = labels(i)
|
||
col = col + 1
|
||
Next i
|
||
|
||
' BOM字段表头
|
||
ws.Cells(1, col).value = "行号": col = 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
|
||
ws.Cells(1, col).value = "数量": col = col + 1
|
||
ws.Cells(1, col).value = "类别": col = col + 1
|
||
ws.Cells(1, col).value = "66代码": col = col + 1
|
||
ws.Cells(1, col).value = "提取备注": col = col + 1
|
||
End Sub
|
||
|
||
'=====================================================================
|
||
' 过程: WriteOutputRow
|
||
' 功能: 写入输出行
|
||
' 参数: ws - 工作表对象
|
||
' row - 行号
|
||
' fullModel - 完整型号
|
||
' headerModel - 表头型号
|
||
' conditions - 条件字典
|
||
' note - 备注
|
||
' item - BOM项(可为Nothing)
|
||
'=====================================================================
|
||
Private Sub WriteOutputRow(ws As Worksheet, _
|
||
row As Long, _
|
||
FullModel As String, _
|
||
HeaderModel As String, _
|
||
Conditions As Object, _
|
||
note As String, _
|
||
item As BomItem)
|
||
Dim col As Long
|
||
col = 1
|
||
|
||
ws.Cells(row, col).value = FullModel: col = col + 1
|
||
ws.Cells(row, col).value = HeaderModel: col = col + 1
|
||
|
||
' 写入条件值
|
||
Dim condNames() As String
|
||
Dim labels() As String
|
||
GetConditionConfig condNames, labels
|
||
|
||
Dim i As Long
|
||
For i = LBound(condNames) To UBound(condNames)
|
||
If Conditions.Exists(condNames(i)) Then
|
||
ws.Cells(row, col).value = Conditions(condNames(i))
|
||
Else
|
||
ws.Cells(row, col).value = ""
|
||
End If
|
||
col = col + 1
|
||
Next i
|
||
|
||
' 写入BOM数据
|
||
If Not item Is Nothing Then
|
||
ws.Cells(row, col).value = item.RowNumber: col = col + 1
|
||
ws.Cells(row, col).value = item.Module: col = col + 1
|
||
ws.Cells(row, col).value = item.code: col = col + 1
|
||
ws.Cells(row, col).value = item.Name: col = col + 1
|
||
ws.Cells(row, col).value = item.Quantity: col = col + 1
|
||
ws.Cells(row, col).value = item.category: col = col + 1
|
||
ws.Cells(row, col).value = item.Code66: col = col + 1
|
||
Else
|
||
col = col + 7 ' 跳过BOM字段
|
||
End If
|
||
|
||
ws.Cells(row, col).value = note
|
||
End Sub
|
||
|
||
'=====================================================================
|
||
' 过程: GetConditionConfig
|
||
' 功能: 获取条件配置
|
||
' 参数: outNames - 输出条件名称数组
|
||
' outLabels - 输出条件标签数组
|
||
'=====================================================================
|
||
Private Sub GetConditionConfig(ByRef outNames() As String, ByRef outLabels() As String)
|
||
Dim configs() As String
|
||
configs = Split(CONDITION_CONFIG, "|")
|
||
|
||
ReDim outNames(LBound(configs) To UBound(configs))
|
||
ReDim outLabels(LBound(configs) To UBound(configs))
|
||
|
||
Dim i As Long
|
||
Dim parts() As String
|
||
|
||
For i = LBound(configs) To UBound(configs)
|
||
parts = Split(configs(i), ",")
|
||
outNames(i) = Trim(parts(0))
|
||
outLabels(i) = Trim(parts(1))
|
||
Next i
|
||
End Sub
|
||
|
||
'=====================================================================
|
||
' 函数: GetInputSheet
|
||
' 功能: 获取输入工作表
|
||
' 返回: Worksheet - 输入工作表对象
|
||
'=====================================================================
|
||
Private Function GetInputSheet() As Worksheet
|
||
' 这里假设输入数据在当前活动工作表或名为"订单"的工作表
|
||
On Error Resume Next
|
||
Set GetInputSheet = ThisWorkbook.Worksheets("产品订单")
|
||
If GetInputSheet Is Nothing Then
|
||
Set GetInputSheet = ActiveSheet
|
||
End If
|
||
On Error GoTo 0
|
||
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
|
||
|
||
'=====================================================================
|
||
' 函数: CreateOutputSheet
|
||
' 功能: 创建或获取输出工作表
|
||
' 返回: Worksheet - 输出工作表对象
|
||
'=====================================================================
|
||
Private Function CreateOutputSheet() As Worksheet
|
||
Dim wsName As String
|
||
wsName = "BOM提取结果"
|
||
|
||
On Error Resume Next
|
||
Set CreateOutputSheet = ThisWorkbook.Worksheets(wsName)
|
||
On Error GoTo 0
|
||
|
||
If CreateOutputSheet Is Nothing Then
|
||
Set CreateOutputSheet = ThisWorkbook.Worksheets.Add
|
||
CreateOutputSheet.Name = wsName
|
||
Else
|
||
' 清空现有数据
|
||
CreateOutputSheet.Cells.Clear
|
||
End If
|
||
End Function
|
||
|
||
'=====================================================================
|
||
' 过程: FormatOutputSheet
|
||
' 功能: 格式化输出工作表
|
||
' 参数: ws - 工作表对象
|
||
'=====================================================================
|
||
Private Sub FormatOutputSheet(ws As Worksheet)
|
||
On Error Resume Next
|
||
|
||
' 设置表头格式
|
||
With ws.Rows(1)
|
||
.Font.Bold = True
|
||
.Interior.Color = RGB(217, 217, 217)
|
||
.HorizontalAlignment = xlCenter
|
||
End With
|
||
|
||
' ' 自动调整列宽
|
||
' ws.Columns.AutoFit
|
||
'
|
||
' ' 冻结首行
|
||
' ws.Rows(2).Select
|
||
' 'ActiveWindow.FreezePanes = True
|
||
' ws.Cells(1, 1).Select
|
||
|
||
On Error GoTo 0
|
||
End Sub |