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

82
VBA/Modules/MainModule.bas
View File

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