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
174
VBA/Modules/AccessDataModule.bas
Normal file
174
VBA/Modules/AccessDataModule.bas
Normal file
@@ -0,0 +1,174 @@
|
||||
'=====================================================================
|
||||
' 模块名: AccessDataModule
|
||||
' 功能: 连接Access数据库，根据[总排号]提取数据并填充到[产品订单]工作表
|
||||
'=====================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
'=====================================================================
|
||||
' 配置区域 (请根据你的实际情况修改以下常量)
|
||||
'=====================================================================
|
||||
' Access数据库文件的完整路径
|
||||
Private Const DB_PATH = "\\192.168.110.114\生产进度表\2025年数据\生产合同数据.accdb"
|
||||
' Access中目标数据表的名称
|
||||
Private Const TARGET_TABLE = "26年压力表合同数据"
|
||||
|
||||
'=====================================================================
|
||||
' 过程: FetchDataFromAccess
|
||||
' 功能: 主控程序，执行数据提取和回填逻辑
|
||||
'=====================================================================
|
||||
Public Sub FetchDataFromAccess()
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
Dim startTime As Double
|
||||
startTime = Timer
|
||||
|
||||
Dim ws As Worksheet
|
||||
Set ws = GetOrderSheet()
|
||||
If ws Is Nothing Then
|
||||
MsgBox "未找到[产品订单]工作表，请检查工作表名称。", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim lastRow As Long
|
||||
lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row
|
||||
|
||||
If lastRow < 2 Then
|
||||
MsgBox "[产品订单]工作表中没有需要处理的数据。", vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 1. 将Excel数据读入内存数组 (A到F列)
|
||||
Dim dataArr As Variant
|
||||
dataArr = ws.Range("A2:F" & lastRow).value
|
||||
|
||||
' 收集所有的总排号，用于构建SQL查询条件
|
||||
Dim queueNums As String
|
||||
Dim i As Long
|
||||
Dim currentNum As String
|
||||
|
||||
For i = 1 To UBound(dataArr, 1)
|
||||
currentNum = Trim(dataArr(i, 1))
|
||||
If currentNum <> "" Then
|
||||
' 假设总排号是文本类型。如果是纯数字类型，请去掉单引号
|
||||
queueNums = queueNums & "'" & currentNum & "',"
|
||||
End If
|
||||
Next i
|
||||
|
||||
If queueNums = "" Then
|
||||
MsgBox "没有找到有效的总排号。", vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 去除最后一个逗号
|
||||
queueNums = Left(queueNums, Len(queueNums) - 1)
|
||||
|
||||
' 2. 连接Access数据库并查询
|
||||
Dim cn As Object
|
||||
Dim rs As Object
|
||||
Set cn = CreateObject("ADODB.Connection")
|
||||
Set rs = CreateObject("ADODB.Recordset")
|
||||
|
||||
' 构建连接字符串 (适用于 .accdb 格式)
|
||||
Dim connStr As String
|
||||
connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DB_PATH & ";"
|
||||
|
||||
cn.Open connStr
|
||||
|
||||
' 构建SQL语句，只提取需要的字段和匹配的总排号
|
||||
Dim sql As String
|
||||
sql = "SELECT 总排号, 生产订单号, 产品型号, 数量, 成品物料码 " & _
|
||||
"FROM [" & TARGET_TABLE & "] " & _
|
||||
"WHERE 总排号 IN (" & queueNums & ")"
|
||||
|
||||
rs.Open sql, cn, 1, 1 ' adOpenKeyset, adLockReadOnly
|
||||
|
||||
' 3. 将查询结果存入字典，利用字典的哈希特性实现极速匹配
|
||||
Dim dbDict As Object
|
||||
Set dbDict = CreateObject("Scripting.Dictionary")
|
||||
|
||||
If Not rs.EOF Then
|
||||
rs.MoveFirst
|
||||
Do Until rs.EOF
|
||||
Dim key As String
|
||||
key = Trim(rs.Fields("总排号").value)
|
||||
|
||||
' 将需要的字段打包成一个数组存入字典
|
||||
If Not dbDict.Exists(key) Then
|
||||
dbDict.Add key, Array( _
|
||||
rs.Fields("生产订单号").value, _
|
||||
rs.Fields("产品型号").value, _
|
||||
rs.Fields("数量").value, _
|
||||
rs.Fields("成品物料码").value _
|
||||
)
|
||||
End If
|
||||
rs.MoveNext
|
||||
Loop
|
||||
End If
|
||||
|
||||
' 关闭数据库连接
|
||||
rs.Close
|
||||
cn.Close
|
||||
Set rs = Nothing
|
||||
Set cn = Nothing
|
||||
|
||||
' 4. 将字典中的数据回填到内存数组
|
||||
Dim matchCount As Long
|
||||
matchCount = 0
|
||||
|
||||
For i = 1 To UBound(dataArr, 1)
|
||||
currentNum = Trim(dataArr(i, 1))
|
||||
If dbDict.Exists(currentNum) Then
|
||||
Dim dbRecord As Variant
|
||||
dbRecord = dbDict(currentNum)
|
||||
|
||||
' 将对应的字段映射到数组的相应列
|
||||
dataArr(i, 2) = dbRecord(0) ' B列: 生产订单号
|
||||
dataArr(i, 3) = dbRecord(1) ' C列: 产品型号
|
||||
dataArr(i, 4) = dbRecord(2) ' D列: 数量
|
||||
dataArr(i, 5) = dbRecord(3) ' E列: 产品编码 (成品物料码)
|
||||
' F列 (部件优先) 保持原样，不作修改
|
||||
|
||||
matchCount = matchCount + 1
|
||||
End If
|
||||
Next i
|
||||
|
||||
' 5. 将更新后的数组一次性写回工作表
|
||||
ws.Range("A2:F" & lastRow).value = dataArr
|
||||
|
||||
' 清理内存
|
||||
Set dbDict = Nothing
|
||||
|
||||
Dim elapsedTime As Double
|
||||
elapsedTime = Timer - startTime
|
||||
|
||||
MsgBox "数据提取完成!" & vbCrLf & _
|
||||
"成功匹配并更新了 " & matchCount & " 条记录。" & vbCrLf & _
|
||||
"用时: " & Format(elapsedTime, "0.00") & " 秒", vbInformation
|
||||
|
||||
Exit Sub
|
||||
|
||||
ErrorHandler:
|
||||
' 确保发生错误时关闭数据库连接
|
||||
On Error Resume Next
|
||||
If Not rs Is Nothing Then
|
||||
If rs.State = 1 Then rs.Close
|
||||
End If
|
||||
If Not cn Is Nothing Then
|
||||
If cn.State = 1 Then cn.Close
|
||||
End If
|
||||
On Error GoTo 0
|
||||
|
||||
MsgBox "提取Access数据时发生异常: " & Err.Description, vbCritical
|
||||
End Sub
|
||||
|
||||
'=====================================================================
|
||||
' 函数: GetOrderSheet
|
||||
' 功能: 获取[产品订单]工作表
|
||||
' 返回: Worksheet - 工作表对象
|
||||
'=====================================================================
|
||||
Private Function GetOrderSheet() As Worksheet
|
||||
On Error Resume Next
|
||||
Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单")
|
||||
On Error GoTo 0
|
||||
End Function
|
||||
Reference in New Issue
Block a user