Compare commits

...

10 Commits

Author SHA1 Message Date
Misaka_Company
dd6ae4c005 feat: add component inventory check module
Implement automatic component inventory verification that marks
orders with insufficient stock as "Component Priority = No".

Key features:
- Reads orders from [产品订单] worksheet
- Parses BOM to identify component category materials
- Validates inventory against [现存量] worksheet
- Allocates stock in order sequence
- Handles missing components with warnings instead of errors
- Provides detailed statistics on completion

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-02 17:55:08 +08:00
Misaka_Company
57adf860ac feat: add additional features (fjgn) support
- Add fjgn (附加功能) field extraction from instrument characteristics
- Extract additional features from model number's instrument feature field
- Merge all fields from index 5 onwards to handle dot separators in features
- Remove oil-fill type (Y+digit) suffix from additional features
- Normalize separators (comma and dot) to comma for consistent parsing
- Implement multi-value matching for fjgn conditions (contains logic)
  - fjgn=N1: true if fjgn contains N1
  - fjgn!=N1: true if fjgn does not contain N1
- Add fjgn to condition config in MainModule and BIPUploadModule

Fixes issue where additional features with dot separators (e.g., N3.N2.Y3)
were incorrectly parsed by merging all fields from index 5 onwards.

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-02 11:04:19 +08:00
Misaka_Company
a22ee42119 chore: remove auto-generated metadata from file headers
- Remove "作者: Auto-generated" and date fields from module headers
- Clean up unnecessary metadata comments

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-02 10:09:40 +08:00
Misaka_Company
6e45d6bdd2 refactor: standardize variable naming and file formatting
- Rename Quantity to quantity in BomItem for consistent naming convention
- Update references in MainModule to use lowercase quantity
- Add newlines at end of files for consistency
- Update vba_metadata.json with new source path and document module

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-02 10:01:57 +08:00
Misaka
f3047bccb8 docs: add BIPUploadModule flowchart documentation
Add comprehensive flowchart documentation for BIPUploadModule:
- Simplified main flow diagram for management review
- Detailed ProcessOrdersToBIP flowchart
- ProcessSingleOrder sub-process flowchart
- WriteBatchData batch write flowchart
- Data structure specifications
- Key features and performance optimizations
- Execution examples (normal and error cases)
- Related modules and dependencies

Documentation uses Mermaid diagrams for visualization
with proper bracket escaping for compatibility.

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-01 23:25:04 +08:00
Misaka
d68dc945bc perf: optimize output logic using batch array writes
Optimize BIPUploadModule and MainModule for better performance:
- Replace cell-by-cell writes with batch array operations
- Collect all output data in memory using Collection objects
- Use WriteBatchData to write all data in single operation
- Add CreateBIPRowArray and CreateOutputRowArray helper functions
- Remove deprecated WriteBIPRow and WriteOutputRow functions

Performance improvement:
- Before: N cell write operations per row (thousands of Excel calls)
- After: 1 batch write operation for all data
- Expected speedup: 10-100x depending on data volume

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-01 23:06:26 +08:00
Misaka
73491c104b fix: clear error messages between BOM extractions
Fix bug where error messages from previous orders were accumulating:
- Add ClearErrorMessages() public method to BomExtractor class
- Initialize pErrorMessages as new collection in ExtractBom()
- Replace commented-out pErrorMessages.Clear with proper initialization
- Ensures each order's error information is independent

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-01 22:42:00 +08:00
Misaka
c7c12838b2 feat: add component priority support to MainModule
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>
2026-02-01 22:35:25 +08:00
Misaka
c5f2d804fb feat: add component priority exclusion feature
Add support for excluding "部件" category based on component priority flag:
- BomExtractor: Add exclude categories functionality
  - Add pExcludeCategories collection member
  - Add SetExcludeCategories() and ClearExcludeCategories() methods
  - Modify DetermineRequiredCategories() to skip excluded categories

- BIPUploadModule: Read and use component priority field
  - Read component priority from column E of [产品订单] worksheet
  - Pass component priority to ProcessSingleOrder()
  - When priority is "否"/"0"/"FALSE", exclude "部件" category
  - Only extract sub-category materials when component priority is disabled

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-01 22:25:10 +08:00
Misaka
8fae8f0389 feat: add BIP upload module for order processing
Add BIPUploadModule to process product orders and generate BIP upload format:
- Read order data from [产品订单] worksheet
- Extract BOM using existing BomExtractor and ProductModelParser
- Output to [BIP上传模板] with formatted fields:
  - Source document number, product code, quantity
  - Line number (base 7000 + index)
  - Material code (66 code from BOM)
  - Supply method, required date, issue organization
  - Planned outbound quantity, remarks for errors

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-01 22:07:36 +08:00
11 changed files with 1412 additions and 96 deletions

View File

@@ -1,8 +1,6 @@
'=====================================================================
' 类名: BomExtractor
' 功能: BOM提取器,从平台配置清单中提取匹配的物料
' 作者: Auto-generated
' 日期: 2025-01-29
'=====================================================================
Option Explicit
@@ -14,6 +12,7 @@ Private pMatchedItems As collection ' 匹配的BOM项
Private pRequiredCategories As collection ' 需要的类别
Private pCategoryHierarchy As Object ' 类别层次结构 Dictionary(子类别->父类别)
Private pErrorMessages As collection
Private pExcludeCategories As collection ' 需要排除的类别
'=====================================================================
' 方法: Class_Initialize
@@ -26,6 +25,7 @@ Private Sub Class_Initialize()
Set pRequiredCategories = New collection
Set pCategoryHierarchy = CreateObject("Scripting.Dictionary")
Set pErrorMessages = New collection
Set pExcludeCategories = New collection
End Sub
'=====================================================================
@@ -93,6 +93,31 @@ ErrorHandler:
LoadBomData = False
End Function
'=====================================================================
' 方法: SetExcludeCategories
' 功能: 设置需要排除的类别
' 参数: categories - 类别集合
'=====================================================================
Public Sub SetExcludeCategories(categories As collection)
Set pExcludeCategories = categories
End Sub
'=====================================================================
' 方法: ClearExcludeCategories
' 功能: 清空排除类别列表
'=====================================================================
Public Sub ClearExcludeCategories()
Set pExcludeCategories = New collection
End Sub
'=====================================================================
' 方法: ClearErrorMessages
' 功能: 清空错误信息列表
'=====================================================================
Public Sub ClearErrorMessages()
Set pErrorMessages = New collection
End Sub
'=====================================================================
' 方法: ExtractBom
' 功能: 根据产品条件提取BOM
@@ -105,8 +130,7 @@ Public Function ExtractBom(productConditions As Object) As collection
' 清空结果
Set pMatchedItems = New collection
Set pRequiredCategories = New collection
'pErrorMessages.Clear
Set pErrorMessages = New collection
' 第一步:确定需要的类别
DetermineRequiredCategories productConditions
@@ -141,20 +165,34 @@ Private Sub DetermineRequiredCategories(productConditions As Object)
' 遍历所有有效物料,获取唯一类别
For Each item In pAllItems
If item.IsValidItem Then
'
Dim categoryRequired As Boolean
If Trim(item.CategoryCondition) = "" Then
' 无条件,必需类别
categoryRequired = True
Else
' 有条件,评估条件
categoryRequired = pConditionEvaluator.Evaluate(item.CategoryCondition, productConditions)
End If
' 检查是否在排除列表中
Dim isExcluded As Boolean
isExcluded = False
Dim excludeCat As Variant
For Each excludeCat In pExcludeCategories
If item.category = CStr(excludeCat) Then
isExcluded = True
Exit For
End If
Next excludeCat
If categoryRequired Then
If Not uniqueCategories.Exists(item.category) Then
uniqueCategories.Add item.category, True
pRequiredCategories.Add item.category
' 如果不在排除列表中,继续处理
If Not isExcluded Then
'
Dim categoryRequired As Boolean
If Trim(item.CategoryCondition) = "" Then
' 无条件,必需类别
categoryRequired = True
Else
' 有条件,评估条件
categoryRequired = pConditionEvaluator.Evaluate(item.CategoryCondition, productConditions)
End If
If categoryRequired Then
If Not uniqueCategories.Exists(item.category) Then
uniqueCategories.Add item.category, True
pRequiredCategories.Add item.category
End If
End If
End If
End If

View File

@@ -1,8 +1,6 @@
'=====================================================================
' 类名: BomItem
' 功能: BOM物料项数据模型
' 作者: Auto-generated
' 日期: 2025-01-29
'=====================================================================
Option Explicit
@@ -12,7 +10,7 @@ Public RowNumber As Long ' 行号
Public Module As String ' 模块
Public code As String ' 代号
Public Name As String ' 名称
Public Quantity As Double ' 数量
Public quantity As Double ' 数量
Public SelectCondition As String ' 选择条件
Public Remark As String ' 备注
Public category As String ' 类别
@@ -46,7 +44,7 @@ Public Sub LoadFromRow(ws As Worksheet, row As Long)
Me.Module = CStr(ws.Cells(row, 2).value) ' B列: 模块
Me.code = CStr(ws.Cells(row, 3).value) ' C列: 代号
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.Remark = CStr(ws.Cells(row, 7).value) ' G列: 备注
Me.category = CStr(ws.Cells(row, 8).value) ' H列: 类别

View File

@@ -1,8 +1,6 @@
'=====================================================================
' 类名: ConditionEvaluator
' 功能: 解析和评估条件表达式
' 作者: Auto-generated
' 日期: 2025-01-29
'=====================================================================
Option Explicit
@@ -148,7 +146,15 @@ Private Function EvaluateSingleCondition(condition As String, Conditions As Obje
EvaluateSingleCondition = True
Else
actualValue = Conditions(varName)
EvaluateSingleCondition = (actualValue <> value)
' fjgn
If varName = "fjgn" Then
' fjgn!=N1检查actualValue中是否不包含value
EvaluateSingleCondition = (InStr(actualValue, value) = 0)
Else
' 其他字段使用精确匹配
EvaluateSingleCondition = (actualValue <> value)
End If
End If
Exit Function
End If
@@ -166,7 +172,15 @@ Private Function EvaluateSingleCondition(condition As String, Conditions As Obje
EvaluateSingleCondition = False
Else
actualValue = Conditions(varName)
EvaluateSingleCondition = (actualValue = value)
' fjgn
If varName = "fjgn" Then
' fjgn=N1检查actualValue中是否包含value
EvaluateSingleCondition = (InStr(actualValue, value) > 0)
Else
' 其他字段使用精确匹配
EvaluateSingleCondition = (actualValue = value)
End If
End If
Exit Function
End If

View File

@@ -1,8 +1,6 @@
'=====================================================================
' 类名: ProductModelParser
' 功能: 解析产品型号并提取物料选择条件
' 作者: Auto-generated
' 日期: 2025-01-29
'=====================================================================
Option Explicit
@@ -152,6 +150,31 @@ Private Function ParseHeader() As Boolean
lcfw = Trim(dotParts(4))
pConditions.Add "lcfw", lcfw
' 仪表特性 - 第6个位置(索引5)及之后的所有部分
' .(N3.N2.Y3)5
Dim fjgn As String
If UBound(dotParts) >= 5 Then
Dim instrumentFeature As String
Dim i As Long
instrumentFeature = ""
' 5.
For i = 5 To UBound(dotParts)
If instrumentFeature = "" Then
instrumentFeature = dotParts(i)
Else
instrumentFeature = instrumentFeature & "." & dotParts(i)
End If
Next i
instrumentFeature = Trim(instrumentFeature)
fjgn = ExtractAdditionalFeatures(instrumentFeature)
Else
' fjgn
fjgn = ""
End If
pConditions.Add "fjgn", fjgn
ParseHeader = True
Exit Function
@@ -232,3 +255,49 @@ Public Function GetAllConditions() As String
GetAllConditions = result
End Function
'=====================================================================
' 方法: ExtractAdditionalFeatures
' 功能: 从仪表特性中提取附加功能
' : instrumentFeature - ("N2,N3.Y3""Y3")
' 返回: String - 附加功能字符串,多个功能用逗号分隔
' 说明:
' 1. 识别并去除充油类型(位于最后格式为Y+一位数字)
' 2. 统一分隔符处理(将.替换为,)
' 3. 去除可能的后缀分隔符
'=====================================================================
Private Function ExtractAdditionalFeatures(instrumentFeature As String) As String
On Error GoTo ErrorHandler
Dim result As String
result = Trim(instrumentFeature)
' 1. 检查是否以Y+数字结尾(充油类型)
If Len(result) >= 2 Then
Dim lastTwoChars As String
lastTwoChars = Right(result, 2)
' Y+
If UCase(Left(lastTwoChars, 1)) = "Y" And IsNumeric(Right(lastTwoChars, 1)) Then
' 去掉充油类型
result = Left(result, Len(result) - 2)
result = Trim(result)
End If
End If
' 2. 处理可能的分隔符(,或.
' .,
result = Replace(result, ".", ",")
' 3.
If Len(result) > 0 And Right(result, 1) = "," Then
result = Left(result, Len(result) - 1)
End If
ExtractAdditionalFeatures = Trim(result)
Exit Function
ErrorHandler:
'
ExtractAdditionalFeatures = ""
End Function

View File

@@ -0,0 +1,16 @@
'=====================================================================
' 主按钮点击事件
' 功能: 执行BOM提取和BIP上传
'=====================================================================
Private Sub CommandButton1_Click()
Call ProcessProductModels
Call ProcessOrdersToBIP
End Sub
'=====================================================================
' 部件库存核对按钮点击事件
' 功能: 执行部件库存核对,标记库存不足的订单
'=====================================================================
Private Sub CommandButton2_Click()
Call CheckComponentInventory
End Sub

View File

@@ -0,0 +1,420 @@
'=====================================================================
' 模块名: BIPUploadModule
' 功能: 处理产品订单数据提取BOM后生成[BIP上传模板]格式数据
'=====================================================================
Option Explicit
'=====================================================================
' 常量定义
'=====================================================================
' 提取条件配置
Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围|fjgn,附加功能"
' 行号基数
Private Const ROW_NUMBER_BASE = 7000
'=====================================================================
' 过程: 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 orderNumber 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列部件优先
' 跳过空行
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
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行数据并添加到集合
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, _
lineIndex, item.Code66, itemNote)
lineIndex = lineIndex + 1
Next item
End If
End Sub
'=====================================================================
' 函数: CreateBIPRowArray
' 功能: 创建BIP上传模板一行数据的数组
' 参数: orderNumber - 生产订单号
' productCode - 产品编码
' quantity - 生产数量
' lineIndex - 行号索引从1开始
' materialCode - 材料编码66编码
' note - 备注
' 返回: Variant() - 包含10个元素的数组
'=====================================================================
Private Function CreateBIPRowArray(orderNumber As String, _
productCode As String, _
quantity As String, _
lineIndex 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) = ROW_NUMBER_BASE + lineIndex ' 行号 = 基数 + 索引
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

View File

@@ -0,0 +1,470 @@
'=====================================================================
' 模块名: ComponentInventoryCheckModule
' 功能: 部件库存核对模块 - 自动核对产品订单中"部件"类物料的库存情况
' 说明: 当库存不足时,按订单顺序将超出部分的订单的"部件优先"字段标记为"否"
'=====================================================================
Option Explicit
'=====================================================================
' 数据结构定义 - 使用字典以支持引用更新
'=====================================================================
' 订单字典键
Private Const ORDER_ROW As String = "RowNumber"
Private Const ORDER_MODEL As String = "ProductModel"
Private Const ORDER_QUANTITY As String = "Quantity"
Private Const ORDER_COMP_CODE As String = "ComponentCode"
Private Const ORDER_COMP_QTY As String = "ComponentQty"
Private Const ORDER_HAS_COMP As String = "HasComponent"
Private Const ORDER_PARSE_ERR As String = "ParseError"
' 部件库存字典键
Private Const INV_CODE As String = "ComponentCode"
Private Const INV_DEMAND As String = "TotalDemand"
Private Const INV_STOCK As String = "AvailableStock"
Private Const INV_SHORTAGE As String = "IsShortage"
' 统计信息结构
Private Type Statistics
TotalOrders As Long ' 总订单数
OrdersWithComponent As Long ' 包含部件的订单数
OrdersSufficient As Long ' 库存充足订单数
OrdersInsufficient As Long ' 库存不足订单数
OrdersSkipped As Long ' 跳过订单数
End Type
'=====================================================================
' 主入口程序
'=====================================================================
Public Sub CheckComponentInventory()
On Error GoTo ErrorHandler
Dim startTime As Double
startTime = Timer
' 获取工作表对象
Dim orderSheet As Worksheet
Dim inventorySheet As Worksheet
Dim bomSheet As Worksheet
Set orderSheet = GetOrderSheet()
If orderSheet Is Nothing Then
MsgBox "未找到[产品订单]工作表!", vbExclamation
Exit Sub
End If
Set inventorySheet = GetInventorySheet()
If inventorySheet Is Nothing Then
MsgBox "未找到[现存量]工作表!", vbExclamation
Exit Sub
End If
Set bomSheet = GetBomSheet()
If bomSheet Is Nothing Then
MsgBox "未找到[平台配置清单]工作表!", vbExclamation
Exit Sub
End If
' 检查订单数据
Dim lastRow As Long
lastRow = orderSheet.Cells(orderSheet.Rows.Count, 2).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
If Not bomExtractor.LoadBomData Then
MsgBox "加载BOM数据失败:" & bomExtractor.GetErrorSummary, vbCritical
Exit Sub
End If
' 读取库存数据到字典
Dim inventoryData As Object
Set inventoryData = LoadInventoryData(inventorySheet)
If inventoryData.Count = 0 Then
MsgBox "[现存量]工作表没有有效数据!", vbExclamation
Exit Sub
End If
' 读取订单数据
Dim orders As Collection
Set orders = LoadOrderData(orderSheet)
If orders.Count = 0 Then
MsgBox "没有有效的订单数据!", vbExclamation
Exit Sub
End If
' 解析所有订单的BOM
ParseAllOrdersBOM orders, bomExtractor
' 统计部件总需求
Dim componentDemands As Object
Set componentDemands = CalculateComponentDemand(orders)
If componentDemands.Count = 0 Then
MsgBox "没有订单包含'部件'类别物料,无需处理库存!", vbInformation
Exit Sub
End If
' 验证库存
Dim validationWarnings As Collection
Set validationWarnings = ValidateInventory(componentDemands, inventoryData)
' 按订单顺序分配库存
Dim stats As Statistics
AllocateInventory orders, componentDemands, orderSheet, stats
' 输出结果统计
Dim elapsedTime As Double
elapsedTime = Timer - startTime
Dim resultMsg As String
resultMsg = "部件库存核对完成!" & vbCrLf & vbCrLf
resultMsg = resultMsg & "处理订单数: " & stats.TotalOrders & vbCrLf
resultMsg = resultMsg & "包含部件订单: " & stats.OrdersWithComponent & vbCrLf
resultMsg = resultMsg & "库存充足订单: " & stats.OrdersSufficient & vbCrLf
resultMsg = resultMsg & "库存不足订单: " & stats.OrdersInsufficient & vbCrLf
If stats.OrdersSkipped > 0 Then
resultMsg = resultMsg & "跳过订单数: " & stats.OrdersSkipped & vbCrLf
End If
resultMsg = resultMsg & vbCrLf & "耗时: " & Format(elapsedTime, "0.00") & "秒"
' 显示警告信息(如果有)
If validationWarnings.Count > 0 Then
resultMsg = resultMsg & vbCrLf & vbCrLf & "警告信息:" & vbCrLf
resultMsg = resultMsg & JoinCollection(validationWarnings, vbCrLf)
End If
MsgBox resultMsg, vbInformation
Exit Sub
ErrorHandler:
MsgBox "部件库存核对异常: " & Err.Description, vbCritical
End Sub
'=====================================================================
' 函数: LoadOrderData
' 功能: 读取订单数据
' 参数: ws - [产品订单]工作表
' 返回: Collection - 每个元素是字典对象,包含订单信息
'=====================================================================
Private Function LoadOrderData(ws As Worksheet) As Collection
Set LoadOrderData = New Collection
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 2).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列: 产品数量
' 跳过空行
If model <> "" Then
Dim order As Object
Set order = CreateObject("Scripting.Dictionary")
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_COMP_CODE, ""
order.Add ORDER_COMP_QTY, 0
order.Add ORDER_HAS_COMP, False
order.Add ORDER_PARSE_ERR, ""
LoadOrderData.Add order
End If
Next i
End Function
'=====================================================================
' 函数: LoadInventoryData
' 功能: 读取库存数据
' 参数: ws - [现存量]工作表
' 返回: Dictionary(物料编码 -> 库存数量)
'=====================================================================
Private Function LoadInventoryData(ws As Worksheet) As Object
Set LoadInventoryData = CreateObject("Scripting.Dictionary")
' 从第4行开始读取(第3行是表头)
Dim lastRow As Long
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列: 结存主数量
If code <> "" And Not IsEmpty(qty) Then
If Not LoadInventoryData.Exists(code) Then
LoadInventoryData.Add code, CDbl(qty)
End If
End If
Next i
End Function
'=====================================================================
' 过程: ParseAllOrdersBOM
' 功能: 解析所有订单的BOM
' 参数: orders - 订单集合(每个元素是字典)
' bomExtractor - BOM提取器
'=====================================================================
Private Sub ParseAllOrdersBOM(orders As Collection, bomExtractor As BomExtractor)
Dim i As Long
For i = 1 To orders.Count
Dim order As Object
Set order = orders(i)
ParseOrderBOM order, bomExtractor
Next i
End Sub
'=====================================================================
' 过程: ParseOrderBOM
' 功能: 解析单个订单的BOM,识别部件类别物料
' 参数: orderInfo - 订单信息字典(ByRef)
' bomExtractor - BOM提取器
'=====================================================================
Private Sub ParseOrderBOM(ByRef orderInfo As Object, bomExtractor As BomExtractor)
On Error Resume Next
' 解析型号
Dim parser As ProductModelParser
Set parser = New ProductModelParser
If Not parser.Parse(orderInfo(ORDER_MODEL)) Then
orderInfo(ORDER_PARSE_ERR) = "解析失败: " & parser.ErrorMessage
Exit Sub
End If
' 提取BOM
Dim matchedItems As Collection
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_HAS_COMP) = True
Exit For
End If
Next item
End Sub
'=====================================================================
' 函数: CalculateComponentDemand
' 功能: 统计部件总需求
' 参数: orders - 订单集合
' 返回: Dictionary(部件编码 -> 库存信息字典)
'=====================================================================
Private Function CalculateComponentDemand(orders As Collection) As Object
Dim demands As Object
Set demands = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 1 To orders.Count
Dim order As Object
Set order = orders(i)
If order(ORDER_HAS_COMP) Then
Dim demand As Double
demand = order(ORDER_COMP_QTY) * order(ORDER_QUANTITY)
Dim compCode As String
compCode = order(ORDER_COMP_CODE)
If demands.Exists(compCode) Then
Dim compInv As Object
Set compInv = demands(compCode)
compInv(INV_DEMAND) = compInv(INV_DEMAND) + demand
Else
Dim newComp As Object
Set newComp = CreateObject("Scripting.Dictionary")
newComp.Add INV_CODE, compCode
newComp.Add INV_DEMAND, demand
newComp.Add INV_STOCK, 0
newComp.Add INV_SHORTAGE, False
demands.Add compCode, newComp
End If
End If
Next i
Set CalculateComponentDemand = demands
End Function
'=====================================================================
' 函数: ValidateInventory
' 功能: 验证库存数据
' 参数: componentDemands - 部件需求字典
' inventoryData - 库存数据字典
' 返回: Collection - 警告信息集合(找不到的部件)
'=====================================================================
Private Function ValidateInventory(componentDemands As Object, _
inventoryData As Object) As Collection
Set ValidateInventory = New Collection
Dim code As Variant
For Each code In componentDemands.Keys
Dim compInv As Object
Set compInv = componentDemands(code)
' 检查库存中是否存在该部件
If Not inventoryData.Exists(compInv(INV_CODE)) Then
' 库存中找不到设置库存为0并添加警告
compInv(INV_STOCK) = 0
compInv(INV_SHORTAGE) = True
ValidateInventory.Add "部件 '" & compInv(INV_CODE) & "' 在[现存量]中未找到"
Else
' 设置可用库存
compInv(INV_STOCK) = inventoryData(compInv(INV_CODE))
' 检查是否短缺
If compInv(INV_DEMAND) > compInv(INV_STOCK) Then
compInv(INV_SHORTAGE) = True
End If
End If
Next code
End Function
'=====================================================================
' 过程: AllocateInventory
' 功能: 按订单顺序分配库存并标记
' 参数: orders - 订单集合
' componentDemands - 部件需求字典
' orderSheet - 订单工作表
' stats - 统计信息(ByRef)
'=====================================================================
Private Sub AllocateInventory(orders As Collection, _
componentDemands As Object, _
orderSheet As Worksheet, _
ByRef stats As Statistics)
' 初始化统计
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
Dim order As Object
Set order = orders(i)
' 跳过解析失败的订单
If order(ORDER_PARSE_ERR) <> "" Then
stats.OrdersSkipped = stats.OrdersSkipped + 1
GoTo NextOrder
End If
' 跳过没有部件的订单
If Not order(ORDER_HAS_COMP) Then
stats.OrdersSkipped = stats.OrdersSkipped + 1
GoTo NextOrder
End If
' 跳过数量为0的订单
If order(ORDER_QUANTITY) = 0 Then
stats.OrdersSkipped = stats.OrdersSkipped + 1
GoTo NextOrder
End If
stats.OrdersWithComponent = stats.OrdersWithComponent + 1
' 获取部件库存信息
Dim compInv As Object
Set compInv = componentDemands(order(ORDER_COMP_CODE))
' 计算需求量
Dim requiredQty As Double
requiredQty = order(ORDER_COMP_QTY) * order(ORDER_QUANTITY)
' 检查库存是否充足
If compInv(INV_STOCK) >= requiredQty Then
' 库存充足,扣减库存,保持原值
compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty
stats.OrdersSufficient = stats.OrdersSufficient + 1
Else
' 库存不足,标记为"否"
orderSheet.Cells(order(ORDER_ROW), 5).Value = "否"
compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty
stats.OrdersInsufficient = stats.OrdersInsufficient + 1
End If
NextOrder:
Next i
End Sub
'=====================================================================
' 函数: GetOrderSheet
' 功能: 获取[产品订单]工作表
' 返回: Worksheet
'=====================================================================
Private Function GetOrderSheet() As Worksheet
On Error Resume Next
Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单")
On Error GoTo 0
End Function
'=====================================================================
' 函数: GetInventorySheet
' 功能: 获取[现存量]工作表
' 返回: Worksheet
'=====================================================================
Private Function GetInventorySheet() As Worksheet
On Error Resume Next
Set GetInventorySheet = ThisWorkbook.Worksheets("现存量")
On Error GoTo 0
End Function
'=====================================================================
' 函数: GetBomSheet
' 功能: 获取[平台配置清单]工作表
' 返回: Worksheet
'=====================================================================
Private Function GetBomSheet() As Worksheet
On Error Resume Next
Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单")
On Error GoTo 0
End Function
'=====================================================================
' 函数: JoinCollection
' 功能: 将集合内容连接为字符串
' 参数: coll - 集合
' separator - 分隔符
' 返回: String
'=====================================================================
Private Function JoinCollection(coll As Collection, separator As String) As String
Dim result As String
result = ""
Dim item As Variant
Dim isFirst As Boolean
isFirst = True
For Each item In coll
If Not isFirst Then
result = result & separator
End If
result = result & CStr(item)
isFirst = False
Next item
JoinCollection = result
End Function

View File

@@ -1,8 +1,6 @@
'=====================================================================
' 模块名: MainModule
' 功能: 主控模块,处理产品型号提取和BOM匹配的上层逻辑
' 作者: Auto-generated
' 日期: 2025-01-29
'=====================================================================
Option Explicit
@@ -11,7 +9,7 @@ Option Explicit
' 常量定义
'=====================================================================
' 提取条件配置(可灵活扩展)
Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围"
Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围|fjgn,附加功能"
'=====================================================================
' 过程: ProcessProductModels
@@ -60,12 +58,13 @@ Public Sub ProcessProductModels()
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 outputData As collection
Set outputData = New collection
Dim i As Long
Dim modelString As String
Dim processedCount As Long
@@ -75,14 +74,21 @@ Public Sub ProcessProductModels()
' 假设产品型号在第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, BomExtractor, outputSheet, outputRow)
' 处理单个型号,收集数据
ProcessSingleModel modelString, componentPriority, BomExtractor, outputData
processedCount = processedCount + 1
End If
Next i
' 批量写入数据到工作表
If outputData.Count > 0 Then
WriteBatchData outputSheet, outputData
End If
' 格式化输出表
FormatOutputSheet outputSheet
@@ -103,22 +109,26 @@ ErrorHandler:
End Sub
'=====================================================================
' 函数: ProcessSingleModel
' 功能: 处理单个产品型号
' 过程: ProcessSingleModel
' 功能: 处理单个产品型号,将数据添加到输出集合
' 参数: modelString - 产品型号字符串
' componentPriority - 部件优先标志("是"或"否"
' bomExtractor - BOM提取器对象
' outputSheet - 输出工作表
' startRow - 起始行号
' 返回: Long - 下一个可用行号
' outputData - 输出数据集合
'=====================================================================
Private Function ProcessSingleModel(modelString As String, _
BomExtractor As BomExtractor, _
outputSheet As Worksheet, _
startRow As Long) As Long
Private Sub ProcessSingleModel(modelString As String, _
componentPriority As String, _
BomExtractor As BomExtractor, _
outputData As collection)
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
@@ -130,9 +140,8 @@ Private Function ProcessSingleModel(modelString As String, _
If Not parser.Parse(modelString) Then
' 解析失败
extractNote = "解析失败: " & parser.ErrorMessage
WriteOutputRow outputSheet, currentRow, modelString, "", parser.Conditions, extractNote, Nothing
ProcessSingleModel = currentRow + 1
Exit Function
outputData.Add CreateOutputRowArray(modelString, "", parser.Conditions, extractNote, Nothing)
Exit Sub
End If
' 提取BOM
@@ -152,8 +161,7 @@ Private Function ProcessSingleModel(modelString As String, _
If extractNote = "" Then
extractNote = "未匹配到任何物料"
End If
WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, extractNote, Nothing
currentRow = currentRow + 1
outputData.Add CreateOutputRowArray(modelString, parser.HeaderModel, parser.Conditions, extractNote, Nothing)
Else
' 输出每个匹配的物料
Dim item As BomItem
@@ -171,18 +179,14 @@ Private Function ProcessSingleModel(modelString As String, _
End If
If isFirst Then
WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, itemNote, item
outputData.Add CreateOutputRowArray(modelString, parser.HeaderModel, parser.Conditions, itemNote, item)
isFirst = False
Else
WriteOutputRow outputSheet, currentRow, "", "", parser.Conditions, itemNote, item
outputData.Add CreateOutputRowArray("", "", parser.Conditions, itemNote, item)
End If
currentRow = currentRow + 1
Next item
End If
ProcessSingleModel = currentRow
End Function
End Sub
'=====================================================================
' 过程: WriteOutputHeader
@@ -219,58 +223,109 @@ Private Sub WriteOutputHeader(ws As Worksheet)
End Sub
'=====================================================================
' 过程: WriteOutputRow
' 功能: 写入输出行
' 参数: ws - 工作表对象
' row - 行
' fullModel - 完整型号
' headerModel - 表头型号
' conditions - 条件字典
' 函数: CreateOutputRowArray
' 功能: 创建输出行数据的数组
' 参数: FullModel - 完整型号
' HeaderModel - 表头型
' Conditions - 条件字典
' note - 备注
' item - BOM项(可为Nothing)
' 返回: Variant() - 行数据数组
'=====================================================================
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
' 写入条件值
Private Function CreateOutputRowArray(FullModel As String, _
HeaderModel 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
Dim totalCols As Long
totalCols = 2 + (UBound(condNames) - LBound(condNames) + 1) + 8
' 创建数组
ReDim rowData(1 To totalCols) As Variant
Dim col As Long
col = 1
' 产品型号和表头型号
rowData(col) = FullModel: col = col + 1
rowData(col) = HeaderModel: col = col + 1
' 写入条件值
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))
rowData(col) = Conditions(condNames(i))
Else
ws.Cells(row, col).value = ""
rowData(col) = ""
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
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
col = col + 7 ' 跳过BOM字段
' 跳过BOM字段
col = col + 7
End If
ws.Cells(row, col).value = note
' 备注
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
'=====================================================================

View File

@@ -1,8 +1,6 @@
'=====================================================================
' 模块名: TestModule
' 功能: 单元测试模块
' 作者: Auto-generated
' 日期: 2025-01-29
'=====================================================================
Option Explicit

View File

@@ -1,6 +1,12 @@
{
"source_file": "C:\\Users\\pengq\\Downloads\\AutoBOM\\AutoBOM\\YTHN-100_-_Claude3.xlsm",
"source_file": "C:\\Users\\Administrator\\Desktop\\新BOM\\AutoBOM\\YTHN-100.xlsm",
"modules": {
"Sheet9.cls": {
"name": "Sheet9",
"type": "DocumentModules",
"attributes": {},
"file": "DocumentModules\\Sheet9.cls"
},
"MainModule.bas": {
"name": "MainModule",
"type": "Modules",
@@ -36,6 +42,12 @@
"type": "ClassModules",
"attributes": {},
"file": "ClassModules\\ProductModelParser.cls"
},
"BIPUploadModule.bas": {
"name": "BIPUploadModule",
"type": "Modules",
"attributes": {},
"file": "Modules\\BIPUploadModule.bas"
}
}
}

View File

@@ -0,0 +1,226 @@
# BIPUploadModule 流程图文档
## 模块概述
**模块名**: BIPUploadModule
**功能**: 处理产品订单数据提取BOM后生成[BIP上传模板]格式数据
**主入口**: ProcessOrdersToBIP
## ProcessOrdersToBIP 流程图(简化版)
```mermaid
flowchart TD
Start([开始处理]) --> Init["初始化<br/>1. 获取工作表<br/>2. 加载BOM库"]
Init --> Loop["循环处理每个订单"]
Loop --> Read["读取订单信息<br/>- 生产订单号<br/>- 产品型号<br/>- 数量<br/>- 产品编码<br/>- 部件优先标志"]
Read --> Parse["解析产品型号<br/>提取规格参数"]
Parse --> Extract["提取BOM物料<br/>根据规格参数匹配物料库"]
Extract --> CheckPriority{"部件优先=否?"}
CheckPriority -->|是| SkipComponent["排除'部件'类别<br/>只提取子类别物料"]
CheckPriority -->|否| KeepAll["保留所有物料"]
SkipComponent --> Generate
KeepAll --> Generate["生成BIP上传数据<br/>- 订单信息<br/>- 物料清单<br/>- 行号编码"]
Generate --> Collect["收集到内存集合"]
Collect --> NextOrder{"还有订单?"}
NextOrder -->|是| Loop
NextOrder -->|否| BatchWrite["批量写入[BIP上传模板]"]
BatchWrite --> Format["格式化表格"]
Format --> End([完成])
style Init fill:#e1f5e1
style Parse fill:#fff3cd
style Extract fill:#d1ecf1
style Generate fill:#d1ecf1
style BatchWrite fill:#f8d7da
style End fill:#e1f5e1
```
---
## ProcessSingleOrder 子流程(详细版)
> 注:以下为技术人员提供详细流程图
```mermaid
flowchart TD
Start([开始 ProcessSingleOrder]) --> ClearExclude["清空排除类别<br/>ClearExcludeCategories"]
ClearExclude --> CheckPriority{"部件优先?"}
CheckPriority -->|否/0/FALSE| AddExclude["创建排除类别集合<br/>添加: 部件"]
AddExclude --> SetExclude["设置排除类别"]
SetExclude --> ParseModel
CheckPriority -->|是| ParseModel["解析产品型号<br/>ProductModelParser.Parse"]
ParseModel --> CheckParse{"解析成功?"}
CheckParse -->|否| CreateError1["创建错误行数据<br/>备注: 解析失败信息"]
CreateError1 --> AddError1["添加到outputData"] --> End1([返回])
CheckParse -->|是| ExtractBOM["提取BOM<br/>BomExtractor.ExtractBom"]
ExtractBOM --> GetErrors["获取错误信息摘要"]
GetErrors --> CheckMatch{"匹配到物料?"}
CheckMatch -->|否| SetError1["设置备注: 未匹配到任何物料"]
SetError1 --> CreateError2["创建空记录行数据"]
CreateError2 --> AddError2["添加到outputData"] --> End2([返回])
CheckMatch -->|是| InitLine["初始化行号索引 lineIndex = 1"]
InitLine --> StartLoop["开始循环物料"]
StartLoop --> GetItem["获取物料项"]
GetItem --> InitNote["初始化备注 = 提取错误"]
InitNote --> CheckItemError{"物料有错误?"}
CheckItemError -->|是| AppendError["追加物料错误信息"]
CheckItemError -->|否| CreateRow
AppendError --> CreateRow["创建BIP行数据<br/>CreateBIPRowArray"]
CreateRow --> AddRow["添加到outputData"]
AddRow --> IncLine["lineIndex++"]
IncLine --> NextLoop{"还有物料?"}
NextLoop -->|是| StartLoop
NextLoop -->|否| End3([返回])
```
## WriteBatchData 批量写入流程
```mermaid
flowchart TD
Start([开始 WriteBatchData]) --> CheckData{"outputData为空?"}
CheckData -->|是| End1([直接返回])
CheckData -->|否| GetRowCount["获取行数 rowCount"]
GetRowCount --> CreateArray["创建二维数组<br/>resultData1 to rowCount, 1 to 10"]
CreateArray --> StartLoop["开始循环: i = 1 to rowCount"]
StartLoop --> GetRowArray["获取行数组 rowArray = outputDatai"]
GetRowArray --> FillArray["填充二维数组<br/>resultDatai, 1 to 10 = rowArray1 to 10"]
FillArray --> NextLoop{"i++ 还有数据?"}
NextLoop -->|是| StartLoop
NextLoop -->|否| WriteSheet["一次性写入工作表<br/>A2单元格.Resize rowCount, 10"]
WriteSheet --> End([完成])
```
## 数据结构说明
### BIP上传模板字段 (10列)
| 列号 | 字段名 | 说明 | 数据来源 |
|------|--------|------|----------|
| 1 | 来源单据号(生产订单号) | 订单唯一标识 | [产品订单] A列 |
| 2 | 产品编码 | 产品代码 | [产品订单] D列 |
| 3 | 生产数量 | 生产数量 | [产品订单] C列 |
| 4 | 行号 | BOM行号 = 7000 + 索引 | 自动生成7001, 7002... |
| 5 | 材料编码 | 物料66编码 | BOM提取结果 |
| 6 | 供应方式 | 固定值 | "一般发料" |
| 7 | 需用日期 | 日期 | 当天日期 Date |
| 8 | 发料组织 | 固定值 | "重庆布莱迪仪器仪表有限公司" |
| 9 | 计划出库数量 | 数量 | 与生产数量一致 |
| 10 | 备注 | 异常信息 | BOM提取错误/异常 |
### [产品订单] 工作表结构 (5列)
| 列号 | 字段名 | 说明 | 必填 |
|------|--------|------|------|
| A | 生产订单号 | 订单唯一标识 | 是 |
| B | 产品型号 | 产品完整型号 | 是 |
| C | 数量 | 生产数量 | 是 |
| D | 产品编码 | 产品代码 | 否 |
| E | 部件优先 | 是否优先提取部件类别 | 否 |
## 关键特性
### 1. 性能优化
- **批量写入**: 使用数组一次性写入所有数据,而非逐个单元格写入
- **内存缓存**: 所有数据先收集到Collection对象最后统一输出
- **预期性能提升**: 10-100倍取决于数据量
### 2. 部件优先功能
-`部件优先` = "否"/"0"/"FALSE"时:
- 排除"部件"类别的物料
- 只提取"部件"的子类别物料(如"接头"、"弹性元件"等)
-`部件优先` = "是"或其他值时:
- 正常提取所有物料,包括"部件"类别及其子类别
### 3. 错误处理
- **必填字段验证**: 生产订单号、产品型号、数量
- **解析失败处理**: 记录错误信息到备注列
- **BOM提取异常**: 记录匹配失败和异常信息
- **空行处理**: 自动跳过完全空白的行
### 4. 数据完整性
- 每次运行前清空旧数据(保留表头)
- 自动创建[BIP上传模板]工作表(如不存在)
- 行号自动生成7001, 7002, 7003...
- 日期自动填充为当天日期
## 执行示例
### 正常流程示例
```
输入: [产品订单] 3行数据
- 订单001, 型号MD-100, 数量10, 编码P001, 部件优先=是
- 订单002, 型号MD-200, 数量20, 编码P002, 部件优先=否
- 订单003, 型号MD-300, 数量30, 编码P003, 部件优先=是
处理流程:
1. 读取3行订单数据
2. 逐个解析产品型号
3. 根据部件优先设置提取BOM
4. 订单001: 提取5种物料包括部件
5. 订单002: 提取4种物料排除部件只提取子类别
6. 订单003: 提取6种物料包括部件
7. 批量写入15行数据到[BIP上传模板]
8. 显示完成信息: 处理3个订单生成15行BOM数据
输出: [BIP上传模板] 15行数据
```
### 异常处理示例
```
输入: [产品订单] 包含异常数据
- 订单A01, 型号INVALID, 数量5 ← 型号解析失败
- 订单A02, 型号MD-100, 数量0 ← 未匹配到任何物料
- 订单A03, 型号MD-200, 数量10 ← 正常提取3种物料
输出:
第1行: 订单A01, ..., 备注: "解析失败: 无效的型号格式"
第2行: 订单A02, ..., 备注: "未匹配到任何物料"
第3-5行: 订单A03, 3种物料数据
```
## 相关模块
### 依赖的类模块
- **BomExtractor**: BOM提取器负责从平台配置清单中提取匹配的物料
- **ProductModelParser**: 产品型号解析器,解析型号字符串为结构化条件
- **BomItem**: BOM物料项数据模型
- **ConditionEvaluator**: 条件评估器,评估选择条件和类别条件
### 相关模块
- **MainModule**: 主控模块处理产品型号提取和BOM匹配
- 类似的处理逻辑
- 输出到[BOM提取结果]工作表
- 支持部件优先功能
- 使用相同的批量写入优化
## 版本历史
| 版本 | 日期 | 说明 |
|------|------|------|
| 1.0 | 2026-02-01 | 初始版本实现基本的订单处理和BOM提取功能 |
| 1.1 | 2026-02-01 | 添加部件优先功能,支持排除特定类别 |
| 1.2 | 2026-02-01 | 性能优化,使用数组批量写入替代逐个单元格写入 |
| 1.3 | 2026-02-01 | 修复Mermaid流程图方括号转义问题 |