feat: add Access data integration and total queue number column

- 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

View File

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

View File

@@ -10,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 ' 类别
@@ -44,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

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