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

feat: add core VBA source code modules

Browse Source 
Add VBA directory with essential project code including:
- ClassModules: BomExtractor, BomItem, ConditionEvaluator, ProductModelParser
- Modules: MainModule, TestModule
- Forms and DocumentModules
- vba_metadata.json for module metadata

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
Misaka
2026-02-01 16:18:17 +08:00
parent 80d9734b91
commit 79dc7cbf72
7 changed files with 1726 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

371
VBA/Modules/MainModule.bas Normal file
View File

@@ -0,0 +1,371 @@
'=====================================================================
' 模块名: MainModule
' 功能: 主控模块,处理产品型号提取和BOM匹配的上层逻辑
' 作者: Auto-generated
' 日期: 2025-01-29
'=====================================================================
Option Explicit
'=====================================================================
' 常量定义
'=====================================================================
' 提取条件配置(可灵活扩展)
Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围"
'=====================================================================
' 过程: ProcessProductModels
' 功能: 批量处理产品型号并输出结果
' 说明: 这是主入口程序
'=====================================================================
Public Sub ProcessProductModels()
On Error GoTo ErrorHandler
Dim startTime As Double
startTime = Timer
' 准备输入输出
Dim inputSheet As Worksheet
Dim outputSheet As Worksheet
Dim bomSheet As Worksheet
' 获取工作表
Set inputSheet = GetInputSheet()
If inputSheet Is Nothing Then
MsgBox "未找到输入工作表,请确保工作簿中有包含订单数据的工作表", vbCritical
Exit Sub
End If
' 获取BOM库工作表
Set bomSheet = GetBomSheet()
If bomSheet Is Nothing Then
MsgBox "未找到'平台配置清单'工作表,请确保BOM数据存在", vbCritical
Exit Sub
End If
' 创建或获取输出工作表
Set outputSheet = CreateOutputSheet()
' 初始化BOM提取器
Dim BomExtractor As BomExtractor
Set BomExtractor = New BomExtractor
BomExtractor.SetWorksheet bomSheet
If Not BomExtractor.LoadBomData Then
MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical
Exit Sub
End If
' 处理每个产品型号
Dim lastRow As Long
lastRow = inputSheet.Cells(inputSheet.Rows.Count, 1).End(xlUp).row
Dim outputRow As Long
outputRow = 2 ' 从第2行开始输出(第1行是表头)
' 写入输出表头
WriteOutputHeader outputSheet
Dim i As Long
Dim modelString As String
Dim processedCount As Long
processedCount = 0
' 假设产品型号在第1列,从第2行开始
For i = 2 To lastRow
modelString = Trim(inputSheet.Cells(i, 2).value)
If modelString <> "" Then
' 处理单个型号
outputRow = ProcessSingleModel(modelString, BomExtractor, outputSheet, outputRow)
processedCount = processedCount + 1
End If
Next i
' 格式化输出表
FormatOutputSheet outputSheet
Dim elapsedTime As Double
elapsedTime = Timer - startTime
MsgBox "处理完成!" & vbCrLf & _
"处理型号数: " & processedCount & vbCrLf & _
"用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation
' 激活输出表
outputSheet.Activate
Exit Sub
ErrorHandler:
MsgBox "处理异常: " & Err.description, vbCritical
End Sub
'=====================================================================
' 函数: ProcessSingleModel
' 功能: 处理单个产品型号
' 参数: modelString - 产品型号字符串
' bomExtractor - BOM提取器对象
' outputSheet - 输出工作表
' startRow - 起始行号
' 返回: Long - 下一个可用行号
'=====================================================================
Private Function ProcessSingleModel(modelString As String, _
BomExtractor As BomExtractor, _
outputSheet As Worksheet, _
startRow As Long) As Long
On Error Resume Next
Dim currentRow As Long
currentRow = startRow
' 解析产品型号
Dim parser As ProductModelParser
Set parser = New ProductModelParser
Dim extractNote As String
extractNote = ""
If Not parser.Parse(modelString) Then
' 解析失败
extractNote = "解析失败: " & parser.ErrorMessage
WriteOutputRow outputSheet, currentRow, modelString, "", parser.Conditions, extractNote, Nothing
ProcessSingleModel = currentRow + 1
Exit Function
End If
' 提取BOM
Dim matchedItems As collection
Set matchedItems = BomExtractor.ExtractBom(parser.Conditions)
' 获取错误信息
Dim bomErrors As String
bomErrors = BomExtractor.GetErrorSummary
If bomErrors <> "" Then
extractNote = bomErrors
End If
' 输出结果
If matchedItems.Count = 0 Then
' 没有匹配项
If extractNote = "" Then
extractNote = "未匹配到任何物料"
End If
WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, extractNote, Nothing
currentRow = currentRow + 1
Else
' 输出每个匹配的物料
Dim item As BomItem
Dim isFirst As Boolean
isFirst = True
For Each item In matchedItems
Dim itemNote As String
itemNote = extractNote
' 添加物料特定的错误
If item.MatchError <> "" Then
If itemNote <> "" Then itemNote = itemNote & "; "
itemNote = itemNote & item.MatchError
End If
If isFirst Then
WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, itemNote, item
isFirst = False
Else
WriteOutputRow outputSheet, currentRow, "", "", parser.Conditions, itemNote, item
End If
currentRow = currentRow + 1
Next item
End If
ProcessSingleModel = currentRow
End Function
'=====================================================================
' 过程: WriteOutputHeader
' 功能: 写入输出表头
' 参数: ws - 工作表对象
'=====================================================================
Private Sub WriteOutputHeader(ws As Worksheet)
Dim col As Long
col = 1
ws.Cells(1, col).value = "产品型号": col = col + 1
ws.Cells(1, col).value = "表头型号": col = col + 1
' 写入条件字段表头
Dim Conditions() As String
Dim labels() As String
GetConditionConfig Conditions, labels
Dim i As Long
For i = LBound(Conditions) To UBound(Conditions)
ws.Cells(1, col).value = labels(i)
col = col + 1
Next i
' BOM字段表头
ws.Cells(1, col).value = "行号": col = col + 1
ws.Cells(1, col).value = "模块": col = col + 1
ws.Cells(1, col).value = "代号": col = col + 1
ws.Cells(1, col).value = "名称": col = col + 1
ws.Cells(1, col).value = "数量": col = col + 1
ws.Cells(1, col).value = "类别": col = col + 1
ws.Cells(1, col).value = "66代码": col = col + 1
ws.Cells(1, col).value = "提取备注": col = col + 1
End Sub
'=====================================================================
' 过程: WriteOutputRow
' 功能: 写入输出行
' 参数: ws - 工作表对象
' row - 行号
' fullModel - 完整型号
' headerModel - 表头型号
' conditions - 条件字典
' note - 备注
' item - BOM项(可为Nothing)
'=====================================================================
Private Sub WriteOutputRow(ws As Worksheet, _
row As Long, _
FullModel As String, _
HeaderModel As String, _
Conditions As Object, _
note As String, _
item As BomItem)
Dim col As Long
col = 1
ws.Cells(row, col).value = FullModel: col = col + 1
ws.Cells(row, col).value = HeaderModel: col = col + 1
' 写入条件值
Dim condNames() As String
Dim labels() As String
GetConditionConfig condNames, labels
Dim i As Long
For i = LBound(condNames) To UBound(condNames)
If Conditions.Exists(condNames(i)) Then
ws.Cells(row, col).value = Conditions(condNames(i))
Else
ws.Cells(row, col).value = ""
End If
col = col + 1
Next i
' 写入BOM数据
If Not item Is Nothing Then
ws.Cells(row, col).value = item.RowNumber: col = col + 1
ws.Cells(row, col).value = item.Module: col = col + 1
ws.Cells(row, col).value = item.code: col = col + 1
ws.Cells(row, col).value = item.Name: col = col + 1
ws.Cells(row, col).value = item.Quantity: col = col + 1
ws.Cells(row, col).value = item.category: col = col + 1
ws.Cells(row, col).value = item.Code66: col = col + 1
Else
col = col + 7 ' 跳过BOM字段
End If
ws.Cells(row, col).value = note
End Sub
'=====================================================================
' 过程: GetConditionConfig
' 功能: 获取条件配置
' 参数: outNames - 输出条件名称数组
' outLabels - 输出条件标签数组
'=====================================================================
Private Sub GetConditionConfig(ByRef outNames() As String, ByRef outLabels() As String)
Dim configs() As String
configs = Split(CONDITION_CONFIG, "|")
ReDim outNames(LBound(configs) To UBound(configs))
ReDim outLabels(LBound(configs) To UBound(configs))
Dim i As Long
Dim parts() As String
For i = LBound(configs) To UBound(configs)
parts = Split(configs(i), ",")
outNames(i) = Trim(parts(0))
outLabels(i) = Trim(parts(1))
Next i
End Sub
'=====================================================================
' 函数: GetInputSheet
' 功能: 获取输入工作表
' 返回: Worksheet - 输入工作表对象
'=====================================================================
Private Function GetInputSheet() As Worksheet
' 这里假设输入数据在当前活动工作表或名为"订单"的工作表
On Error Resume Next
Set GetInputSheet = ThisWorkbook.Worksheets("产品订单")
If GetInputSheet Is Nothing Then
Set GetInputSheet = ActiveSheet
End If
On Error GoTo 0
End Function
'=====================================================================
' 函数: GetBomSheet
' 功能: 获取BOM工作表
' 返回: Worksheet - BOM工作表对象
'=====================================================================
Private Function GetBomSheet() As Worksheet
On Error Resume Next
Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单")
On Error GoTo 0
End Function
'=====================================================================
' 函数: CreateOutputSheet
' 功能: 创建或获取输出工作表
' 返回: Worksheet - 输出工作表对象
'=====================================================================
Private Function CreateOutputSheet() As Worksheet
Dim wsName As String
wsName = "BOM提取结果"
On Error Resume Next
Set CreateOutputSheet = ThisWorkbook.Worksheets(wsName)
On Error GoTo 0
If CreateOutputSheet Is Nothing Then
Set CreateOutputSheet = ThisWorkbook.Worksheets.Add
CreateOutputSheet.Name = wsName
Else
' 清空现有数据
CreateOutputSheet.Cells.Clear
End If
End Function
'=====================================================================
' 过程: FormatOutputSheet
' 功能: 格式化输出工作表
' 参数: ws - 工作表对象
'=====================================================================
Private Sub FormatOutputSheet(ws As Worksheet)
On Error Resume Next
' 设置表头格式
With ws.Rows(1)
.Font.Bold = True
.Interior.Color = RGB(217, 217, 217)
.HorizontalAlignment = xlCenter
End With
' ' 自动调整列宽
' ws.Columns.AutoFit
'
' ' 冻结首行
' ws.Rows(2).Select
' 'ActiveWindow.FreezePanes = True
' ws.Cells(1, 1).Select
On Error GoTo 0
End Sub