- 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>
440 lines
14 KiB
QBasic
440 lines
14 KiB
QBasic
'=====================================================================
|
||
' 模块名: MainModule
|
||
' 功能: 主控模块,处理产品型号提取和BOM匹配的上层逻辑
|
||
'=====================================================================
|
||
|
||
Option Explicit
|
||
|
||
'=====================================================================
|
||
' 常量定义
|
||
'=====================================================================
|
||
' 提取条件配置(可灵活扩展)
|
||
Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围|fjgn,附加功能"
|
||
|
||
'=====================================================================
|
||
' 过程: 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
|
||
|
||
' 写入输出表头
|
||
WriteOutputHeader outputSheet
|
||
|
||
' 收集所有输出数据
|
||
Dim outputData As Collection
|
||
Set outputData = New Collection
|
||
|
||
Dim i As Long
|
||
Dim modelString As String
|
||
Dim processedCount As Long
|
||
|
||
processedCount = 0
|
||
|
||
' 假设数据从第2行开始
|
||
For i = 2 To lastRow
|
||
Dim totalQueueNum As String
|
||
Dim orderNumber As String
|
||
Dim componentPriority As String
|
||
|
||
' --- 核心修改:调整列索引以适应新增的“总排号” ---
|
||
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
|
||
' 处理单个型号,收集数据,增加 totalQueueNum 参数
|
||
ProcessSingleModel totalQueueNum, orderNumber, modelString, componentPriority, BomExtractor, outputData
|
||
processedCount = processedCount + 1
|
||
End If
|
||
Next i
|
||
|
||
' 批量写入数据到工作表
|
||
If outputData.count > 0 Then
|
||
WriteBatchData outputSheet, outputData
|
||
End If
|
||
|
||
' 格式化输出表
|
||
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
|
||
' 功能: 处理单个产品型号,将数据添加到输出集合
|
||
' 参数: orderNumber - 生产订单号
|
||
' modelString - 产品型号字符串
|
||
' componentPriority - 部件优先标志("是"或"否")
|
||
' bomExtractor - BOM提取器对象
|
||
' outputData - 输出数据集合
|
||
'=====================================================================
|
||
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
|
||
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
|
||
outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.Conditions, extractNote, Nothing)
|
||
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 CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.Conditions, extractNote, Nothing)
|
||
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
|
||
' 首行保留总排号和订单号
|
||
outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.Conditions, itemNote, item)
|
||
isFirst = False
|
||
Else
|
||
' 同一个型号的后续BOM项,总排号和订单号留空以保持报表整洁
|
||
outputData.Add CreateOutputRowArray("", "", modelString, parser.Conditions, itemNote, item)
|
||
End If
|
||
Next item
|
||
End If
|
||
End Sub
|
||
|
||
'=====================================================================
|
||
' 过程: 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
|
||
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
|
||
|
||
'=====================================================================
|
||
' 函数: CreateOutputRowArray
|
||
' 功能: 创建输出行数据的数组
|
||
' 参数: orderNumber - 生产订单号
|
||
' FullModel - 完整型号
|
||
' Conditions - 条件字典
|
||
' note - 备注
|
||
' item - BOM项(可为Nothing)
|
||
' 返回: 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
|
||
|
||
' 计算总列数:3 (排号+订单+型号) + 条件数 + 8 (BOM+备注)
|
||
Dim totalCols As Long
|
||
totalCols = 3 + (UBound(condNames) - LBound(condNames) + 1) + 8
|
||
|
||
' 创建数组
|
||
ReDim rowData(1 To totalCols) As Variant
|
||
|
||
Dim col As Long
|
||
col = 1
|
||
|
||
' 基础信息
|
||
rowData(col) = totalQueueNum: col = col + 1
|
||
rowData(col) = orderNumber: col = col + 1
|
||
rowData(col) = FullModel: col = col + 1
|
||
|
||
' 写入条件值
|
||
Dim i As Long
|
||
For i = LBound(condNames) To UBound(condNames)
|
||
If Conditions.Exists(condNames(i)) Then
|
||
rowData(col) = Conditions(condNames(i))
|
||
Else
|
||
rowData(col) = ""
|
||
End If
|
||
col = col + 1
|
||
Next i
|
||
|
||
' 写入BOM数据
|
||
If Not item Is Nothing Then
|
||
rowData(col) = item.RowNumber: col = col + 1
|
||
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.category: col = col + 1
|
||
rowData(col) = item.Code66: col = col + 1
|
||
Else
|
||
' 跳过BOM字段
|
||
col = col + 7
|
||
End If
|
||
|
||
' 备注
|
||
rowData(col) = note
|
||
|
||
CreateOutputRowArray = 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 firstRow As Variant
|
||
firstRow = outputData(1)
|
||
|
||
Dim rowCount As Long
|
||
Dim colCount As Long
|
||
rowCount = outputData.count
|
||
colCount = UBound(firstRow) - LBound(firstRow) + 1
|
||
|
||
' 创建二维数组
|
||
Dim resultData() As Variant
|
||
ReDim resultData(1 To rowCount, 1 To colCount)
|
||
|
||
' 填充数据到二维数组
|
||
Dim i As Long
|
||
Dim j As Long
|
||
Dim rowArray As Variant
|
||
|
||
For i = 1 To rowCount
|
||
rowArray = outputData(i)
|
||
For j = 1 To colCount
|
||
resultData(i, j) = rowArray(j)
|
||
Next j
|
||
Next i
|
||
|
||
' 一次性写入工作表(从第2行开始)
|
||
ws.Range("A2").Resize(rowCount, colCount).value = resultData
|
||
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 |