58e84ddd25
All checks were successful
NTFY Notification / notify (push) Successful in 4s
Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
110 lines
3.5 KiB
QBasic
110 lines
3.5 KiB
QBasic
' ==============================================================================
|
||
' 模块: M01_Main
|
||
' 职责: 程序入口，调度器，UI交互(进度条)
|
||
' ==============================================================================
|
||
Option Explicit
|
||
|
||
Public Sub RunBOMConversion()
|
||
Dim wsSrc As Worksheet
|
||
Dim arrData As Variant
|
||
Dim logger As New clsErrorLogger
|
||
Dim i As Long
|
||
' 使用 Dictionary 替代 Collection 来存储类别，方便查找
|
||
Dim catData As Object
|
||
Set catData = CreateObject("Scripting.Dictionary")
|
||
|
||
' 1. 环境初始化
|
||
On Error GoTo MainErrorHandler
|
||
'Application.ScreenUpdating = False
|
||
Application.Calculation = xlCalculationManual
|
||
|
||
' 2. 检查工作表
|
||
On Error Resume Next
|
||
Set wsSrc = ActiveWorkbook.Sheets("平台配置清单")
|
||
On Error GoTo MainErrorHandler
|
||
|
||
If wsSrc Is Nothing Then
|
||
MsgBox "错误：未找到名为 '平台配置清单' 的工作表。", vbCritical
|
||
GoTo ExitHandler
|
||
End If
|
||
|
||
' 读取数据
|
||
Application.StatusBar = "正在读取源数据..."
|
||
arrData = M02_DataIO.ReadSourceData(wsSrc)
|
||
|
||
If IsEmpty(arrData) Then
|
||
MsgBox "未找到数据。", vbExclamation
|
||
GoTo ExitHandler
|
||
End If
|
||
|
||
' 3. 初始化逻辑模块
|
||
M03_Logic.InitLogic logger
|
||
|
||
' 4. 主循环
|
||
Dim rowIdx As Long
|
||
Dim strCat As String, strCond As String
|
||
Dim colResult As Collection
|
||
Dim itm As Variant
|
||
Dim baseInfo As Variant
|
||
|
||
Dim totalRows As Long
|
||
Dim pct As Long
|
||
totalRows = UBound(arrData, 1)
|
||
|
||
For i = 1 To totalRows
|
||
rowIdx = M04_Config.SRC_START_ROW + i - 1
|
||
strCat = Trim(CStr(arrData(i, M04_Config.COL_IDX_CAT)))
|
||
|
||
' --- 进度条更新 ---
|
||
pct = CLng((i / totalRows) * 100)
|
||
Application.StatusBar = "正在处理: " & pct & "% | 行: " & rowIdx & " | 类别: " & strCat
|
||
If i Mod 10 = 0 Then DoEvents ' 每10行刷新一次界面，防止卡顿但不过度拖慢速度
|
||
' ------------------
|
||
|
||
' 忽略空类别
|
||
If Len(strCat) > 0 Then
|
||
strCond = CStr(arrData(i, M04_Config.COL_IDX_COND))
|
||
If IsEmpty(arrData(i, M04_Config.COL_IDX_COND)) Then strCond = ""
|
||
|
||
' 解析
|
||
Set colResult = M03_Logic.ParseRule(strCond, rowIdx)
|
||
|
||
If Not colResult Is Nothing Then
|
||
If Not catData.Exists(strCat) Then
|
||
catData.Add strCat, New Collection
|
||
End If
|
||
|
||
' 基础信息: 代号, 名称, 数量
|
||
baseInfo = Array(arrData(i, M04_Config.COL_IDX_CODE), _
|
||
arrData(i, M04_Config.COL_IDX_NAME), _
|
||
arrData(i, M04_Config.COL_IDX_QTY))
|
||
|
||
' 将展开的记录存入
|
||
For Each itm In colResult
|
||
catData(strCat).Add Array(itm, baseInfo)
|
||
Next itm
|
||
End If
|
||
End If
|
||
Next i
|
||
|
||
' 5. 输出
|
||
Application.StatusBar = "正在生成新工作簿..."
|
||
M02_DataIO.WriteCategoryToNewBook catData
|
||
|
||
' 6. 错误报告
|
||
If logger.HasErrors Then
|
||
logger.PrintReport ActiveWorkbook
|
||
MsgBox "转换完成，但发现部分数据存在逻辑冲突，已生成错误报告。", vbExclamation
|
||
End If
|
||
|
||
ExitHandler:
|
||
' 清理状态
|
||
Application.StatusBar = False
|
||
Application.ScreenUpdating = True
|
||
Application.Calculation = xlCalculationAutomatic
|
||
Exit Sub
|
||
|
||
MainErrorHandler:
|
||
MsgBox "发生运行时错误: " & Err.Description, vbCritical
|
||
Resume ExitHandler
|
||
End Sub |