admin/AutoBOM
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: add Access data integration and total queue number column

Browse Source 
- 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>
This commit is contained in:
Misaka_Company
2026-03-12 13:53:28 +08:00
parent 787b3f56ab
commit 1747af046b
9 changed files with 343 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
VBA/ClassModules/BomExtractor.cls
View File

@@ -7,12 +7,12 @@ Option Explicit
Private pWorksheet As Worksheet Private pWorksheet As Worksheet
Private pConditionEvaluator As ConditionEvaluator Private pConditionEvaluator As ConditionEvaluator
Private pAllItems As collection ' 所有BOM项 Private pAllItems As Collection ' 所有BOM项
Private pMatchedItems As collection ' 匹配的BOM项 Private pMatchedItems As Collection ' 匹配的BOM项
Private pRequiredCategories As collection ' 需要的类别 Private pRequiredCategories As Collection ' 需要的类别
Private pCategoryHierarchy As Object ' 类别层次结构 Dictionary(子类别->父类别) Private pCategoryHierarchy As Object ' 类别层次结构 Dictionary(子类别->父类别)
Private pErrorMessages As collection Private pErrorMessages As Collection
Private pExcludeCategories As collection ' 需要排除的类别 Private pExcludeCategories As Collection ' 需要排除的类别
'===================================================================== '=====================================================================
' 方法: Class_Initialize ' 方法: Class_Initialize
@@ -20,12 +20,12 @@ Private pExcludeCategories As collection ' 需要排除的类别
'===================================================================== '=====================================================================
Private Sub Class_Initialize() Private Sub Class_Initialize()
Set pConditionEvaluator = New ConditionEvaluator Set pConditionEvaluator = New ConditionEvaluator
Set pAllItems = New collection Set pAllItems = New Collection
Set pMatchedItems = New collection Set pMatchedItems = New Collection
Set pRequiredCategories = New collection Set pRequiredCategories = New Collection
Set pCategoryHierarchy = CreateObject("Scripting.Dictionary") Set pCategoryHierarchy = CreateObject("Scripting.Dictionary")
Set pErrorMessages = New collection Set pErrorMessages = New Collection
Set pExcludeCategories = New collection Set pExcludeCategories = New Collection
End Sub End Sub
'===================================================================== '=====================================================================
@@ -52,12 +52,12 @@ Public Function LoadBomData() As Boolean
End If End If
' 清空现有数据 ' 清空现有数据
Set pAllItems = New collection Set pAllItems = New Collection
Set pCategoryHierarchy = CreateObject("Scripting.Dictionary") Set pCategoryHierarchy = CreateObject("Scripting.Dictionary")
' 从第4行开始读取(第3行是表头) ' 从第4行开始读取(第3行是表头)
Dim lastRow As Long Dim lastRow As Long
lastRow = pWorksheet.Cells(pWorksheet.Rows.Count, 1).End(xlUp).row lastRow = pWorksheet.Cells(pWorksheet.Rows.count, 1).End(xlUp).row
Dim i As Long Dim i As Long
Dim item As BomItem Dim item As BomItem
@@ -89,7 +89,7 @@ Public Function LoadBomData() As Boolean
Exit Function Exit Function
ErrorHandler: ErrorHandler:
pErrorMessages.Add "加载BOM数据异常: " & Err.description pErrorMessages.Add "加载BOM数据异常: " & Err.Description
LoadBomData = False LoadBomData = False
End Function End Function
@@ -98,7 +98,7 @@ End Function
' 功能: 设置需要排除的类别 ' 功能: 设置需要排除的类别
' 参数: categories - 类别集合 ' 参数: categories - 类别集合
'===================================================================== '=====================================================================
Public Sub SetExcludeCategories(categories As collection) Public Sub SetExcludeCategories(categories As Collection)
Set pExcludeCategories = categories Set pExcludeCategories = categories
End Sub End Sub
@@ -107,7 +107,7 @@ End Sub
' 功能: 清空排除类别列表 ' 功能: 清空排除类别列表
'===================================================================== '=====================================================================
Public Sub ClearExcludeCategories() Public Sub ClearExcludeCategories()
Set pExcludeCategories = New collection Set pExcludeCategories = New Collection
End Sub End Sub
'===================================================================== '=====================================================================
@@ -115,7 +115,7 @@ End Sub
' 功能: 清空错误信息列表 ' 功能: 清空错误信息列表
'===================================================================== '=====================================================================
Public Sub ClearErrorMessages() Public Sub ClearErrorMessages()
Set pErrorMessages = New collection Set pErrorMessages = New Collection
End Sub End Sub
'===================================================================== '=====================================================================
@@ -124,13 +124,13 @@ End Sub
' 参数: productConditions - 产品条件字典 ' 参数: productConditions - 产品条件字典
' 返回: Collection - 匹配的BOM项集合 ' 返回: Collection - 匹配的BOM项集合
'===================================================================== '=====================================================================
Public Function ExtractBom(productConditions As Object) As collection Public Function ExtractBom(productConditions As Object) As Collection
On Error GoTo ErrorHandler On Error GoTo ErrorHandler
' 清空结果 ' 清空结果
Set pMatchedItems = New collection Set pMatchedItems = New Collection
Set pRequiredCategories = New collection Set pRequiredCategories = New Collection
Set pErrorMessages = New collection Set pErrorMessages = New Collection
' 第一步:确定需要的类别 ' 第一步:确定需要的类别
DetermineRequiredCategories productConditions DetermineRequiredCategories productConditions
@@ -148,7 +148,7 @@ Public Function ExtractBom(productConditions As Object) As collection
Exit Function Exit Function
ErrorHandler: ErrorHandler:
pErrorMessages.Add "提取BOM异常: " & Err.description pErrorMessages.Add "提取BOM异常: " & Err.Description
Set ExtractBom = pMatchedItems Set ExtractBom = pMatchedItems
End Function End Function
@@ -211,8 +211,8 @@ Private Sub MatchItems(productConditions As Object)
' 遍历每个需要的类别 ' 遍历每个需要的类别
For Each category In pRequiredCategories For Each category In pRequiredCategories
Dim categoryMatches As collection Dim categoryMatches As Collection
Set categoryMatches = New collection Set categoryMatches = New Collection
' 查找该类别下所有匹配的物料 ' 查找该类别下所有匹配的物料
For Each item In pAllItems For Each item In pAllItems
@@ -235,19 +235,19 @@ Private Sub MatchItems(productConditions As Object)
Next item Next item
' 检查匹配结果 ' 检查匹配结果
If categoryMatches.Count = 0 Then If categoryMatches.count = 0 Then
' --------------------------------------------------------- ' ---------------------------------------------------------
' CHANGE: 这里不再立即报错 ' CHANGE: 这里不再立即报错
' 理由: 未匹配到可能是正常的（例如：父类别缺失但子类别齐全，或者子类别被父类别覆盖） ' 理由: 未匹配到可能是正常的（例如：父类别缺失但子类别齐全，或者子类别被父类别覆盖）
' 具体的缺失检查移交到 ValidateResult 方法中统一处理 ' 具体的缺失检查移交到 ValidateResult 方法中统一处理
' --------------------------------------------------------- ' ---------------------------------------------------------
ElseIf categoryMatches.Count = 1 Then ElseIf categoryMatches.count = 1 Then
' 正常:匹配到1条 ' 正常:匹配到1条
pMatchedItems.Add categoryMatches(1) pMatchedItems.Add categoryMatches(1)
Else Else
' 异常:匹配到多条 (这个依然需要报错，因为这是数据源的不确定性错误) ' 异常:匹配到多条 (这个依然需要报错，因为这是数据源的不确定性错误)
Dim multiMsg As String Dim multiMsg As String
multiMsg = "类别[" & category & "]匹配到多条物料(" & categoryMatches.Count & "条)" multiMsg = "类别[" & category & "]匹配到多条物料(" & categoryMatches.count & "条)"
pErrorMessages.Add multiMsg pErrorMessages.Add multiMsg
' 临时处理:输出所有匹配的 ' 临时处理:输出所有匹配的
@@ -303,8 +303,8 @@ Private Sub ApplyAssemblyLogic()
Dim coveredCategories As Object Dim coveredCategories As Object
Set coveredCategories = CreateObject("Scripting.Dictionary") Set coveredCategories = CreateObject("Scripting.Dictionary")
Dim satisfiedParentItems As collection Dim satisfiedParentItems As Collection
Set satisfiedParentItems = New collection Set satisfiedParentItems = New Collection
For Each parentCat In parentToChildren.Keys For Each parentCat In parentToChildren.Keys
' 只有当该父类别确实有匹配物料时才进行检查 ' 只有当该父类别确实有匹配物料时才进行检查
@@ -345,8 +345,8 @@ Private Sub ApplyAssemblyLogic()
Next parentCat Next parentCat
' 4. 构建新的结果集 ' 4. 构建新的结果集
Dim newMatchedItems As collection Dim newMatchedItems As Collection
Set newMatchedItems = New collection Set newMatchedItems = New Collection
' 4.1 先添加满足条件的父类别项 (总成) ' 4.1 先添加满足条件的父类别项 (总成)
For Each item In satisfiedParentItems For Each item In satisfiedParentItems
@@ -459,7 +459,7 @@ End Sub
' 功能: 获取错误信息集合 ' 功能: 获取错误信息集合
' 返回: Collection ' 返回: Collection
'===================================================================== '=====================================================================
Public Function GetErrorMessages() As collection Public Function GetErrorMessages() As Collection
Set GetErrorMessages = pErrorMessages Set GetErrorMessages = pErrorMessages
End Function End Function
@@ -469,7 +469,7 @@ End Function
' 返回: String ' 返回: String
'===================================================================== '=====================================================================
Public Function GetErrorSummary() As String Public Function GetErrorSummary() As String
If pErrorMessages.Count = 0 Then If pErrorMessages.count = 0 Then
GetErrorSummary = "" GetErrorSummary = ""
Else Else
Dim result As String Dim result As String

4
VBA/ClassModules/BomItem.cls
View File

@@ -10,7 +10,7 @@ Public RowNumber As Long ' 行号
Public Module As String ' 模块 Public Module As String ' 模块
Public code As String ' 代号 Public code As String ' 代号
Public Name As String ' 名称 Public Name As String ' 名称
Public quantity As Double ' 数量 Public Quantity As Double ' 数量
Public SelectCondition As String ' 选择条件 Public SelectCondition As String ' 选择条件
Public Remark As String ' 备注 Public Remark As String ' 备注
Public category As String ' 类别 Public category As String ' 类别
@@ -44,7 +44,7 @@ Public Sub LoadFromRow(ws As Worksheet, row As Long)
Me.Module = CStr(ws.Cells(row, 2).value) ' B列: 模块 Me.Module = CStr(ws.Cells(row, 2).value) ' B列: 模块
Me.code = CStr(ws.Cells(row, 3).value) ' C列: 代号 Me.code = CStr(ws.Cells(row, 3).value) ' C列: 代号
Me.Name = CStr(ws.Cells(row, 4).value) ' D列: 名称 Me.Name = CStr(ws.Cells(row, 4).value) ' D列: 名称
Me.quantity = CDbl(ws.Cells(row, 5).value) ' E列: 数量 Me.Quantity = CDbl(ws.Cells(row, 5).value) ' E列: 数量
Me.SelectCondition = CStr(ws.Cells(row, 6).value) ' F列: 选择条件 Me.SelectCondition = CStr(ws.Cells(row, 6).value) ' F列: 选择条件
Me.Remark = CStr(ws.Cells(row, 7).value) ' G列: 备注 Me.Remark = CStr(ws.Cells(row, 7).value) ' G列: 备注
Me.category = CStr(ws.Cells(row, 8).value) ' H列: 类别 Me.category = CStr(ws.Cells(row, 8).value) ' H列: 类别

6
VBA/ClassModules/ProductModelParser.cls
View File

@@ -86,7 +86,7 @@ Public Function Parse(modelString As String) As Boolean
Exit Function Exit Function
ErrorHandler: ErrorHandler:
pErrorMessage = "解析异常: " & Err.description pErrorMessage = "解析异常: " & Err.Description
Parse = False Parse = False
End Function End Function
@@ -179,7 +179,7 @@ Private Function ParseHeader() As Boolean
Exit Function Exit Function
ErrorHandler: ErrorHandler:
pErrorMessage = "解析表头异常: " & Err.description pErrorMessage = "解析表头异常: " & Err.Description
ParseHeader = False ParseHeader = False
End Function End Function
@@ -221,7 +221,7 @@ Private Function ExtractConnectionAndMaterial(code As String, _
Exit Function Exit Function
ErrorHandler: ErrorHandler:
pErrorMessage = "提取过程连接和材质异常: " & Err.description pErrorMessage = "提取过程连接和材质异常: " & Err.Description
ExtractConnectionAndMaterial = False ExtractConnectionAndMaterial = False
End Function End Function

8
VBA/DocumentModules/Sheet9.cls
View File

@@ -13,4 +13,12 @@ End Sub
'===================================================================== '=====================================================================
Private Sub CommandButton2_Click() Private Sub CommandButton2_Click()
Call CheckComponentInventory Call CheckComponentInventory
End Sub
'=====================================================================
' 数据提取按钮点击事件
' 功能:基于总排号查询相关字段数据
'=====================================================================
Private Sub CommandButton3_Click()
Call FetchDataFromAccess
End Sub End Sub

174
VBA/Modules/AccessDataModule.bas Normal file
View File

@@ -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

81
VBA/Modules/BIPUploadModule.bas
View File

@@ -64,7 +64,7 @@ Public Sub ProcessOrdersToBIP()
' 获取订单数据行数 ' 获取订单数据行数
Dim lastRow As Long 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 If lastRow < 2 Then
@@ -73,8 +73,8 @@ Public Sub ProcessOrdersToBIP()
End If End If
' 处理每个订单，收集所有输出数据 ' 处理每个订单，收集所有输出数据
Dim outputData As collection Dim outputData As Collection
Set outputData = New collection Set outputData = New Collection
Dim i As Long Dim i As Long
Dim processedCount As Long Dim processedCount As Long
@@ -85,20 +85,23 @@ Public Sub ProcessOrdersToBIP()
For i = 2 To lastRow For i = 2 To lastRow
' 读取订单数据 ' 读取订单数据
Dim totalQueueNum As String
Dim orderNumber As String Dim orderNumber As String
Dim productModel As String Dim ProductModel As String
Dim quantity As String Dim Quantity As String
Dim productCode As String Dim productCode As String
Dim componentPriority As String Dim componentPriority As String
orderNumber = Trim(orderSheet.Cells(i, 1).value) ' A列：生产订单号 ' --- 核心修改：调整列索引以适应新增的A列“总排号” ---
productModel = Trim(orderSheet.Cells(i, 2).value) ' B列：产品型号 totalQueueNum = Trim(orderSheet.Cells(i, 1).value) ' A列：总排号 (如果后续BIP需要可直接使用此变量)
quantity = Trim(orderSheet.Cells(i, 3).value) ' C列：数量 orderNumber = Trim(orderSheet.Cells(i, 2).value) ' B列：生产订单号
productCode = Trim(orderSheet.Cells(i, 4).value) ' D列：产品编码 ProductModel = Trim(orderSheet.Cells(i, 3).value) ' C列：产品型号
componentPriority = Trim(orderSheet.Cells(i, 5).value) ' E列：部件优先 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 GoTo ContinueLoop
End If End If
@@ -108,12 +111,12 @@ Public Sub ProcessOrdersToBIP()
GoTo ContinueLoop GoTo ContinueLoop
End If End If
If productModel = "" Then If ProductModel = "" Then
MsgBox "第" & i & "行：产品型号为空，跳过该行!", vbExclamation MsgBox "第" & i & "行：产品型号为空，跳过该行!", vbExclamation
GoTo ContinueLoop GoTo ContinueLoop
End If End If
If quantity = "" Then If Quantity = "" Then
MsgBox "第" & i & "行：数量为空，跳过该行!", vbExclamation MsgBox "第" & i & "行：数量为空，跳过该行!", vbExclamation
GoTo ContinueLoop GoTo ContinueLoop
End If End If
@@ -121,7 +124,7 @@ Public Sub ProcessOrdersToBIP()
orderCount = orderCount + 1 orderCount = orderCount + 1
' 处理单个订单，收集输出数据 ' 处理单个订单，收集输出数据
ProcessSingleOrder orderNumber, productModel, quantity, productCode, _ ProcessSingleOrder orderNumber, ProductModel, Quantity, productCode, _
componentPriority, BomExtractor, outputData componentPriority, BomExtractor, outputData
processedCount = processedCount + 1 processedCount = processedCount + 1
@@ -129,7 +132,7 @@ ContinueLoop:
Next i Next i
' 批量写入数据到工作表 ' 批量写入数据到工作表
If outputData.Count > 0 Then If outputData.count > 0 Then
WriteBatchData bipSheet, outputData WriteBatchData bipSheet, outputData
End If End If
@@ -141,7 +144,7 @@ ContinueLoop:
MsgBox "处理完成!" & vbCrLf & _ MsgBox "处理完成!" & vbCrLf & _
"处理订单数: " & orderCount & vbCrLf & _ "处理订单数: " & orderCount & vbCrLf & _
"生成BIP行数: " & outputData.Count & vbCrLf & _ "生成BIP行数: " & outputData.count & vbCrLf & _
"用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation "用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation
' 激活BIP上传模板 ' 激活BIP上传模板
@@ -150,7 +153,7 @@ ContinueLoop:
Exit Sub Exit Sub
ErrorHandler: ErrorHandler:
MsgBox "处理异常: " & Err.description, vbCritical MsgBox "处理异常: " & Err.Description, vbCritical
End Sub End Sub
'===================================================================== '=====================================================================
@@ -165,18 +168,18 @@ End Sub
' outputData - 输出数据集合 ' outputData - 输出数据集合
'===================================================================== '=====================================================================
Private Sub ProcessSingleOrder(orderNumber As String, _ Private Sub ProcessSingleOrder(orderNumber As String, _
productModel As String, _ ProductModel As String, _
quantity As String, _ Quantity As String, _
productCode As String, _ productCode As String, _
componentPriority As String, _ componentPriority As String, _
BomExtractor As BomExtractor, _ BomExtractor As BomExtractor, _
outputData As collection) outputData As Collection)
On Error Resume Next On Error Resume Next
' 根据部件优先设置排除类别 ' 根据部件优先设置排除类别
BomExtractor.ClearExcludeCategories BomExtractor.ClearExcludeCategories
If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then
Dim excludeCats As New collection Dim excludeCats As New Collection
excludeCats.Add "部件" excludeCats.Add "部件"
BomExtractor.SetExcludeCategories excludeCats BomExtractor.SetExcludeCategories excludeCats
End If End If
@@ -188,15 +191,15 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
Dim extractNote As String Dim extractNote As String
extractNote = "" extractNote = ""
If Not parser.Parse(productModel) Then If Not parser.Parse(ProductModel) Then
' 解析失败，添加一行错误记录 ' 解析失败，添加一行错误记录
extractNote = "解析失败: " & parser.ErrorMessage extractNote = "解析失败: " & parser.ErrorMessage
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote) outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote)
Exit Sub Exit Sub
End If End If
' 提取BOM ' 提取BOM
Dim matchedItems As collection Dim matchedItems As Collection
Set matchedItems = BomExtractor.ExtractBom(parser.Conditions) Set matchedItems = BomExtractor.ExtractBom(parser.Conditions)
' 获取错误信息 ' 获取错误信息
@@ -207,12 +210,12 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
End If End If
' 输出结果 ' 输出结果
If matchedItems.Count = 0 Then If matchedItems.count = 0 Then
' 没有匹配项，添加一行空记录 ' 没有匹配项，添加一行空记录
If extractNote = "" Then If extractNote = "" Then
extractNote = "未匹配到任何物料" extractNote = "未匹配到任何物料"
End If End If
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote) outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote)
Else Else
' 输出每个匹配的物料 ' 输出每个匹配的物料
Dim item As BomItem Dim item As BomItem
@@ -230,7 +233,7 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
End If End If
' 创建BIP行数据并添加到集合 ' 创建BIP行数据并添加到集合
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, _ outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, _
lineIndex, item.Code66, itemNote) lineIndex, item.Code66, itemNote)
lineIndex = lineIndex + 1 lineIndex = lineIndex + 1
@@ -251,7 +254,7 @@ End Sub
'===================================================================== '=====================================================================
Private Function CreateBIPRowArray(orderNumber As String, _ Private Function CreateBIPRowArray(orderNumber As String, _
productCode As String, _ productCode As String, _
quantity As String, _ Quantity As String, _
lineIndex As Long, _ lineIndex As Long, _
materialCode As String, _ materialCode As String, _
note As String) As Variant() note As String) As Variant()
@@ -259,13 +262,13 @@ Private Function CreateBIPRowArray(orderNumber As String, _
rowData(1) = orderNumber ' 来源单据号（生产订单号） rowData(1) = orderNumber ' 来源单据号（生产订单号）
rowData(2) = productCode ' 产品编码 rowData(2) = productCode ' 产品编码
rowData(3) = quantity ' 生产数量 rowData(3) = Quantity ' 生产数量
rowData(4) = ROW_NUMBER_BASE + lineIndex ' 行号 = 基数 + 索引 rowData(4) = ROW_NUMBER_BASE + lineIndex ' 行号 = 基数 + 索引
rowData(5) = materialCode ' 材料编码（66编码） rowData(5) = materialCode ' 材料编码（66编码）
rowData(6) = "一般发料" ' 供应方式（固定值） rowData(6) = "一般发料" ' 供应方式（固定值）
rowData(7) = Date ' 需用日期（当天日期） rowData(7) = Date ' 需用日期（当天日期）
rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织（固定值） rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织（固定值）
rowData(9) = quantity ' 计划出库数量（与生产数量一致） rowData(9) = Quantity ' 计划出库数量（与生产数量一致）
rowData(10) = note ' 备注 rowData(10) = note ' 备注
CreateBIPRowArray = rowData CreateBIPRowArray = rowData
@@ -277,15 +280,15 @@ End Function
' 参数: ws - 工作表对象 ' 参数: ws - 工作表对象
' outputData - 输出数据集合，每个元素是一个一维数组 ' 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 Exit Sub
End If End If
' 创建二维数组 ' 创建二维数组
Dim rowCount As Long Dim rowCount As Long
rowCount = outputData.Count rowCount = outputData.count
Dim resultData() As Variant Dim resultData() As Variant
ReDim resultData(1 To rowCount, 1 To 10) ReDim resultData(1 To rowCount, 1 To 10)
@@ -358,7 +361,7 @@ Private Function GetBIPUploadSheet() As Worksheet
If GetBIPUploadSheet Is Nothing Then 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 GetBIPUploadSheet.Name = wsName
End If End If
End Function End Function
@@ -382,7 +385,7 @@ End Function
Private Sub ClearBIPSheetData(ws As Worksheet) Private Sub ClearBIPSheetData(ws As Worksheet)
' 清空从第2行开始的所有数据 ' 清空从第2行开始的所有数据
Dim lastRow As Long 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 If lastRow > 1 Then
ws.Rows("2:" & lastRow).ClearContents ws.Rows("2:" & lastRow).ClearContents

63
VBA/Modules/ComponentInventoryCheckModule.bas
View File

@@ -66,21 +66,21 @@ Public Sub CheckComponentInventory()
Exit Sub Exit Sub
End If End If
' 检查订单数据 ' 检查订单数据 (调整为按C列:产品型号获取最后一行)
Dim lastRow As Long 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 If lastRow < 2 Then
MsgBox "[产品订单]工作表没有数据!", vbExclamation MsgBox "[产品订单]工作表没有数据!", vbExclamation
Exit Sub Exit Sub
End If End If
' 初始化BOM提取器 ' 初始化BOM提取器
Dim bomExtractor As BomExtractor Dim BomExtractor As BomExtractor
Set bomExtractor = New BomExtractor Set BomExtractor = New BomExtractor
bomExtractor.SetWorksheet bomSheet BomExtractor.SetWorksheet bomSheet
If Not bomExtractor.LoadBomData Then If Not BomExtractor.LoadBomData Then
MsgBox "加载BOM数据失败:" & bomExtractor.GetErrorSummary, vbCritical MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical
Exit Sub Exit Sub
End If End If
@@ -88,7 +88,7 @@ Public Sub CheckComponentInventory()
Dim inventoryData As Object Dim inventoryData As Object
Set inventoryData = LoadInventoryData(inventorySheet) Set inventoryData = LoadInventoryData(inventorySheet)
If inventoryData.Count = 0 Then If inventoryData.count = 0 Then
MsgBox "[现存量]工作表没有有效数据!", vbExclamation MsgBox "[现存量]工作表没有有效数据!", vbExclamation
Exit Sub Exit Sub
End If End If
@@ -97,19 +97,19 @@ Public Sub CheckComponentInventory()
Dim orders As Collection Dim orders As Collection
Set orders = LoadOrderData(orderSheet) Set orders = LoadOrderData(orderSheet)
If orders.Count = 0 Then If orders.count = 0 Then
MsgBox "没有有效的订单数据!", vbExclamation MsgBox "没有有效的订单数据!", vbExclamation
Exit Sub Exit Sub
End If End If
' 解析所有订单的BOM ' 解析所有订单的BOM
ParseAllOrdersBOM orders, bomExtractor ParseAllOrdersBOM orders, BomExtractor
' 统计部件总需求 ' 统计部件总需求
Dim componentDemands As Object Dim componentDemands As Object
Set componentDemands = CalculateComponentDemand(orders) Set componentDemands = CalculateComponentDemand(orders)
If componentDemands.Count = 0 Then If componentDemands.count = 0 Then
MsgBox "没有订单包含'部件'类别物料,无需处理库存!", vbInformation MsgBox "没有订单包含'部件'类别物料,无需处理库存!", vbInformation
Exit Sub Exit Sub
End If End If
@@ -138,7 +138,7 @@ Public Sub CheckComponentInventory()
resultMsg = resultMsg & vbCrLf & "耗时: " & Format(elapsedTime, "0.00") & "秒" resultMsg = resultMsg & vbCrLf & "耗时: " & Format(elapsedTime, "0.00") & "秒"
' 显示警告信息（如果有） ' 显示警告信息（如果有）
If validationWarnings.Count > 0 Then If validationWarnings.count > 0 Then
resultMsg = resultMsg & vbCrLf & vbCrLf & "警告信息:" & vbCrLf resultMsg = resultMsg & vbCrLf & vbCrLf & "警告信息:" & vbCrLf
resultMsg = resultMsg & JoinCollection(validationWarnings, vbCrLf) resultMsg = resultMsg & JoinCollection(validationWarnings, vbCrLf)
End If End If
@@ -160,16 +160,18 @@ End Sub
Private Function LoadOrderData(ws As Worksheet) As Collection Private Function LoadOrderData(ws As Worksheet) As Collection
Set LoadOrderData = New Collection Set LoadOrderData = New Collection
' 调整为按C列获取最后一行
Dim lastRow As Long 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 Dim i As Long
For i = 2 To lastRow For i = 2 To lastRow
Dim model As String Dim model As String
Dim qty As Variant Dim qty As Variant
model = Trim(ws.Cells(i, 2).Value) ' B列: 产品型号 ' --- 核心修改：列索引向右移1列 ---
qty = ws.Cells(i, 3).Value ' C列: 产品数量 model = Trim(ws.Cells(i, 3).value) ' C列: 产品型号 (原B列)
qty = ws.Cells(i, 4).value ' D列: 产品数量 (原C列)
' 跳过空行 ' 跳过空行
If model <> "" Then If model <> "" Then
@@ -178,7 +180,7 @@ Private Function LoadOrderData(ws As Worksheet) As Collection
order.Add ORDER_ROW, CLng(i) order.Add ORDER_ROW, CLng(i)
order.Add ORDER_MODEL, CStr(model) 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_CODE, ""
order.Add ORDER_COMP_QTY, 0 order.Add ORDER_COMP_QTY, 0
order.Add ORDER_HAS_COMP, False order.Add ORDER_HAS_COMP, False
@@ -200,15 +202,15 @@ Private Function LoadInventoryData(ws As Worksheet) As Object
' 从第4行开始读取(第3行是表头) ' 从第4行开始读取(第3行是表头)
Dim lastRow As Long 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 Dim i As Long
For i = 4 To lastRow For i = 4 To lastRow
Dim code As String Dim code As String
Dim qty As Variant Dim qty As Variant
code = Trim(ws.Cells(i, 2).Value) ' B列: 物料编码 code = Trim(ws.Cells(i, 2).value) ' B列: 物料编码
qty = ws.Cells(i, 10).Value ' J列: 结存主数量 qty = ws.Cells(i, 10).value ' J列: 结存主数量
If code <> "" And Not IsEmpty(qty) Then If code <> "" And Not IsEmpty(qty) Then
If Not LoadInventoryData.Exists(code) Then If Not LoadInventoryData.Exists(code) Then
@@ -224,12 +226,12 @@ End Function
' 参数: orders - 订单集合(每个元素是字典) ' 参数: orders - 订单集合(每个元素是字典)
' bomExtractor - BOM提取器 ' bomExtractor - BOM提取器
'===================================================================== '=====================================================================
Private Sub ParseAllOrdersBOM(orders As Collection, bomExtractor As BomExtractor) Private Sub ParseAllOrdersBOM(orders As Collection, BomExtractor As BomExtractor)
Dim i As Long Dim i As Long
For i = 1 To orders.Count For i = 1 To orders.count
Dim order As Object Dim order As Object
Set order = orders(i) Set order = orders(i)
ParseOrderBOM order, bomExtractor ParseOrderBOM order, BomExtractor
Next i Next i
End Sub End Sub
@@ -239,7 +241,7 @@ End Sub
' 参数: orderInfo - 订单信息字典(ByRef) ' 参数: orderInfo - 订单信息字典(ByRef)
' bomExtractor - BOM提取器 ' 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 On Error Resume Next
' 解析型号 ' 解析型号
@@ -253,14 +255,14 @@ Private Sub ParseOrderBOM(ByRef orderInfo As Object, bomExtractor As BomExtracto
' 提取BOM ' 提取BOM
Dim matchedItems As Collection Dim matchedItems As Collection
Set matchedItems = bomExtractor.ExtractBom(parser.Conditions) Set matchedItems = BomExtractor.ExtractBom(parser.Conditions)
' 查找"部件"类别物料 ' 查找"部件"类别物料
Dim item As BomItem Dim item As BomItem
For Each item In matchedItems For Each item In matchedItems
If item.category = "部件" Then If item.category = "部件" Then
orderInfo(ORDER_COMP_CODE) = item.Code66 orderInfo(ORDER_COMP_CODE) = item.Code66
orderInfo(ORDER_COMP_QTY) = item.quantity orderInfo(ORDER_COMP_QTY) = item.Quantity
orderInfo(ORDER_HAS_COMP) = True orderInfo(ORDER_HAS_COMP) = True
Exit For Exit For
End If End If
@@ -278,7 +280,7 @@ Private Function CalculateComponentDemand(orders As Collection) As Object
Set demands = CreateObject("Scripting.Dictionary") Set demands = CreateObject("Scripting.Dictionary")
Dim i As Long Dim i As Long
For i = 1 To orders.Count For i = 1 To orders.count
Dim order As Object Dim order As Object
Set order = orders(i) Set order = orders(i)
@@ -355,14 +357,14 @@ Private Sub AllocateInventory(orders As Collection, _
ByRef stats As Statistics) ByRef stats As Statistics)
' 初始化统计 ' 初始化统计
stats.TotalOrders = orders.Count stats.TotalOrders = orders.count
stats.OrdersWithComponent = 0 stats.OrdersWithComponent = 0
stats.OrdersSufficient = 0 stats.OrdersSufficient = 0
stats.OrdersInsufficient = 0 stats.OrdersInsufficient = 0
stats.OrdersSkipped = 0 stats.OrdersSkipped = 0
Dim i As Long Dim i As Long
For i = 1 To orders.Count For i = 1 To orders.count
Dim order As Object Dim order As Object
Set order = orders(i) Set order = orders(i)
@@ -400,8 +402,9 @@ Private Sub AllocateInventory(orders As Collection, _
compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty
stats.OrdersSufficient = stats.OrdersSufficient + 1 stats.OrdersSufficient = stats.OrdersSufficient + 1
Else Else
' --- 核心修改：回填结果写入F列(第6列) ---
' 库存不足,标记为"否" ' 库存不足,标记为"否"
orderSheet.Cells(order(ORDER_ROW), 5).Value = "否" orderSheet.Cells(order(ORDER_ROW), 6).value = "否"
compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty
stats.OrdersInsufficient = stats.OrdersInsufficient + 1 stats.OrdersInsufficient = stats.OrdersInsufficient + 1
End If End If
@@ -467,4 +470,4 @@ Private Function JoinCollection(coll As Collection, separator As String) As Stri
Next item Next item
JoinCollection = result JoinCollection = result
End Function End Function

82
VBA/Modules/MainModule.bas
View File

@@ -56,14 +56,14 @@ Public Sub ProcessProductModels()
' 处理每个产品型号 ' 处理每个产品型号
Dim lastRow As Long 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 WriteOutputHeader outputSheet
' 收集所有输出数据 ' 收集所有输出数据
Dim outputData As collection Dim outputData As Collection
Set outputData = New collection Set outputData = New Collection
Dim i As Long Dim i As Long
Dim modelString As String Dim modelString As String
@@ -71,23 +71,27 @@ Public Sub ProcessProductModels()
processedCount = 0 processedCount = 0
' 假设产品型号在第1列,从第2行开始 ' 假设数据从第2行开始
For i = 2 To lastRow For i = 2 To lastRow
Dim totalQueueNum As String
Dim orderNumber 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 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 If modelString <> "" Then
' 处理单个型号，收集数据 ' 处理单个型号，收集数据，增加 totalQueueNum 参数
ProcessSingleModel orderNumber, modelString, componentPriority, BomExtractor, outputData ProcessSingleModel totalQueueNum, orderNumber, modelString, componentPriority, BomExtractor, outputData
processedCount = processedCount + 1 processedCount = processedCount + 1
End If End If
Next i Next i
' 批量写入数据到工作表 ' 批量写入数据到工作表
If outputData.Count > 0 Then If outputData.count > 0 Then
WriteBatchData outputSheet, outputData WriteBatchData outputSheet, outputData
End If End If
@@ -107,7 +111,7 @@ Public Sub ProcessProductModels()
Exit Sub Exit Sub
ErrorHandler: ErrorHandler:
MsgBox "处理异常: " & Err.description, vbCritical MsgBox "处理异常: " & Err.Description, vbCritical
End Sub End Sub
'===================================================================== '=====================================================================
@@ -119,17 +123,18 @@ End Sub
' bomExtractor - BOM提取器对象 ' bomExtractor - BOM提取器对象
' outputData - 输出数据集合 ' outputData - 输出数据集合
'===================================================================== '=====================================================================
Private Sub ProcessSingleModel(orderNumber As String, _ Private Sub ProcessSingleModel(totalQueueNum As String, _
modelString As String, _ orderNumber As String, _
componentPriority As String, _ modelString As String, _
BomExtractor As BomExtractor, _ componentPriority As String, _
outputData As collection) BomExtractor As BomExtractor, _
outputData As Collection)
On Error Resume Next On Error Resume Next
' 根据部件优先设置排除类别 ' 根据部件优先设置排除类别
BomExtractor.ClearExcludeCategories BomExtractor.ClearExcludeCategories
If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then
Dim excludeCats As New collection Dim excludeCats As New Collection
excludeCats.Add "部件" excludeCats.Add "部件"
BomExtractor.SetExcludeCategories excludeCats BomExtractor.SetExcludeCategories excludeCats
End If End If
@@ -144,12 +149,12 @@ Private Sub ProcessSingleModel(orderNumber As String, _
If Not parser.Parse(modelString) Then If Not parser.Parse(modelString) Then
' 解析失败 ' 解析失败
extractNote = "解析失败: " & parser.ErrorMessage extractNote = "解析失败: " & parser.ErrorMessage
outputData.Add CreateOutputRowArray(orderNumber, modelString, parser.Conditions, extractNote, Nothing) outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.Conditions, extractNote, Nothing)
Exit Sub Exit Sub
End If End If
' 提取BOM ' 提取BOM
Dim matchedItems As collection Dim matchedItems As Collection
Set matchedItems = BomExtractor.ExtractBom(parser.Conditions) Set matchedItems = BomExtractor.ExtractBom(parser.Conditions)
' 获取错误信息 ' 获取错误信息
@@ -160,12 +165,12 @@ Private Sub ProcessSingleModel(orderNumber As String, _
End If End If
' 输出结果 ' 输出结果
If matchedItems.Count = 0 Then If matchedItems.count = 0 Then
' 没有匹配项 ' 没有匹配项
If extractNote = "" Then If extractNote = "" Then
extractNote = "未匹配到任何物料" extractNote = "未匹配到任何物料"
End If End If
outputData.Add CreateOutputRowArray(orderNumber, modelString, parser.Conditions, extractNote, Nothing) outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.Conditions, extractNote, Nothing)
Else Else
' 输出每个匹配的物料 ' 输出每个匹配的物料
Dim item As BomItem Dim item As BomItem
@@ -183,10 +188,12 @@ Private Sub ProcessSingleModel(orderNumber As String, _
End If End If
If isFirst Then If isFirst Then
outputData.Add CreateOutputRowArray(orderNumber, modelString, parser.Conditions, itemNote, item) ' 首行保留总排号和订单号
outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.Conditions, itemNote, item)
isFirst = False isFirst = False
Else Else
outputData.Add CreateOutputRowArray("", modelString, parser.Conditions, itemNote, item) ' 同一个型号的后续BOM项，总排号和订单号留空以保持报表整洁
outputData.Add CreateOutputRowArray("", "", modelString, parser.Conditions, itemNote, item)
End If End If
Next item Next item
End If End If
@@ -201,6 +208,8 @@ Private Sub WriteOutputHeader(ws As Worksheet)
Dim col As Long Dim col As Long
col = 1 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
@@ -236,19 +245,20 @@ End Sub
' item - BOM项(可为Nothing) ' item - BOM项(可为Nothing)
' 返回: Variant() - 行数据数组 ' 返回: Variant() - 行数据数组
'===================================================================== '=====================================================================
Private Function CreateOutputRowArray(orderNumber As String, _ Private Function CreateOutputRowArray(totalQueueNum As String, _
FullModel As String, _ orderNumber As String, _
Conditions As Object, _ FullModel As String, _
note As String, _ Conditions As Object, _
item As BomItem) As Variant() note As String, _
item As BomItem) As Variant()
' 获取条件配置 ' 获取条件配置
Dim condNames() As String Dim condNames() As String
Dim labels() As String Dim labels() As String
GetConditionConfig condNames, labels GetConditionConfig condNames, labels
' 计算总列数：2 + 条件数 + 8 ' 计算总列数：3 (排号+订单+型号) + 条件数 + 8 (BOM+备注)
Dim totalCols As Long 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 ReDim rowData(1 To totalCols) As Variant
@@ -256,7 +266,8 @@ Private Function CreateOutputRowArray(orderNumber As String, _
Dim col As Long Dim col As Long
col = 1 col = 1
' 生产订单号和产品型号 ' 基础信息
rowData(col) = totalQueueNum: col = col + 1
rowData(col) = orderNumber: col = col + 1 rowData(col) = orderNumber: col = col + 1
rowData(col) = FullModel: 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.Module: col = col + 1
rowData(col) = item.code: col = col + 1 rowData(col) = item.code: col = col + 1
rowData(col) = item.Name: 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.category: col = col + 1
rowData(col) = item.Code66: col = col + 1 rowData(col) = item.Code66: col = col + 1
Else Else
@@ -290,16 +301,15 @@ Private Function CreateOutputRowArray(orderNumber As String, _
CreateOutputRowArray = rowData CreateOutputRowArray = rowData
End Function End Function
'===================================================================== '=====================================================================
' 过程: WriteBatchData ' 过程: WriteBatchData
' 功能: 批量写入数据到工作表 ' 功能: 批量写入数据到工作表
' 参数: ws - 工作表对象 ' 参数: ws - 工作表对象
' outputData - 输出数据集合 ' 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 Exit Sub
End If End If
@@ -309,7 +319,7 @@ Private Sub WriteBatchData(ws As Worksheet, outputData As collection)
Dim rowCount As Long Dim rowCount As Long
Dim colCount As Long Dim colCount As Long
rowCount = outputData.Count rowCount = outputData.count
colCount = UBound(firstRow) - LBound(firstRow) + 1 colCount = UBound(firstRow) - LBound(firstRow) + 1
' 创建二维数组 ' 创建二维数组

6
VBA/Modules/TestModule.bas
View File

@@ -234,12 +234,12 @@ Public Sub TestBomExtractor()
testConditions.Add "jycz", "1" testConditions.Add "jycz", "1"
testConditions.Add "lcfw", "M01" testConditions.Add "lcfw", "M01"
Dim matchedItems As collection Dim matchedItems As Collection
Set matchedItems = extractor.ExtractBom(testConditions) 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 " 匹配的物料:" Debug.Print " 匹配的物料:"
Dim item As BomItem Dim item As BomItem
Dim i As Long Dim i As Long