将数组加载到记录集中以循环以增加值 vba 访问

Posted 2023-04-19

【中文标题】将数组加载到记录集中以循环以增加值 vba 访问

【英文标题】：Load arrays into recordset to loop through to increment value vba access

【发布时间】：2017-06-08 21:43:28

【问题描述】：

我正在尝试将 access 数据库的两个表中的值（在与 VBA 代码相同的数据库文件中）加载到数组中，以在 PART FIND NO 与前一个 PART FIND 匹配时循环并增加 EQP_POS_CD 字段中的值不。查询：

SELECT CTOL.ID, CTOL.BOM_PART_NAME, CTOL.CII, CTOL.[PART FIND NO], CTOL.CSN,
       CTOL.AFS, CTOL.EQP_POS_CD, CTOL.LCN, CTOL.POS_CT, CTOL.SERIAL_NO, 
       CTOL.PART_NO_LLP, [CTOL_Asbuilt].[PART-SN], [CTOL_Asbuilt].[PART-ATA-NO], 
       [CTOL_Asbuilt].[PW-PART-NO]
FROM CTOL LEFT JOIN [CTOL_Asbuilt] ON CTOL.[PART FIND NO] = [CTOL_Asbuilt].[PART-ATA-NO];

代码：

Option Compare Database
Option Explicit




'Const adOpenStatic = 3
'Const adLockOptimistic = 3

Function queryDatabase()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As QueryDef
'Dim rsQuery As DAO.Recordset
Dim rows As Variant


Dim part_find_no() As String
Dim eqp_pos_no() As Integer
'Dim strSQL As String

Dim i As Integer
Dim j As Integer
'Set objConnection = CurrentDb.OpenRecordset("CTOL")

Set db = CurrentDb

Set qdf = db.QueryDefs("SicrProcess")

Set rs = qdf.OpenRecordset(dbOpenDynaset)

If rs.EOF Then GoTo Leave
rs.MoveLast
rs.MoveFirst


For i = 0 To rs.RecordCount
    part_find_no() = rs("PART FIND NO")
    eqp_pos_no() = rs("EQP_POS_CD")
    If part_find_no(i) = part_find_no(i - 1) Then
        eqp_pos_no(i) = eqp_pos_no(i) + 1
    End If
    Debug.Print rs.Fields("PART FIND NO") & " " & rs.Fields("EQP_POS_CD")
    rs.MoveNext
Next i

Leave:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    qdf.Close
    Set qdf = Nothing
    Set db = Nothing
    db.Close
    On Error GoTo 0
    Exit Function

ErrProc:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Function

我不确定这里出了什么问题。它期待数组，但我是否必须以某种方式初始化这些数组？如何从查询生成的结果中将这些字段设置为数组？我希望使用该查询的结果加载数组，但只加载这些字段：PART FIND NO 和 EQP_POS_CD。然后，当当前 PART FIND NO 与前一个 PART FIND NO 相同时，它应该遍历两个字段中的行以增加 EQP_POS_CD。关于如何清理这个的任何建议？谢谢。

【问题讨论】：

必须声明一个带维度的数组。如果事先不知道元素的数量，则必须重新调整数组。评论patorjk.com/programming/tutorials/vbarrays.htm

您应该为此使用 SQL，而且速度要快得多。如果您至少仍想使用 VBA，则应在 sql 中添加“order by”子句，以便您的 vba 逻辑可以正常工作。除此之外，您不需要数组只使用两个变量。

【参考方案1】：

我认为不需要数组对象。考虑：

Sub SetSeq()

Dim rs As DAO.Recordset, x As Integer, strPart As String, intSeq As Integer
Set rs = CurrentDb.OpenRecordset("SELECT [Part Find No], EQP_POS_CD FROM CTOL ORDER BY [Part Find No], SERIAL_NO;")

If rs.EOF Then GoTo Leave

rs.MoveLast
rs.MoveFirst
strPart = rs![Part Find No]
For x = 1 To rs.RecordCount
    If rs![Part Find No] <> strPart Then
        intSeq = 0
        strPart = rs![Part Find No]
    End If
    intSeq = intSeq + 1
    rs.Edit
    rs!EQP_POS_CD = intSeq
    rs.Update
    rs.MoveNext
Next x

Leave:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    On Error GoTo 0
    Exit Sub

ErrProc:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Sub

运行代码后的表格：

+------------+--------------+-----------+
| EQP_POS_CD | Part Find No | SERIAL_NO |
+------------+--------------+-----------+
|          1 | a            | abc1      |
|          2 | a            | abc2      |
|          3 | a            | abc3      |
|          1 | b            | abc4      |
|          2 | b            | abc5      |
|          1 | c            | abc6      |
|          2 | c            | abc7      |
|          3 | c            | abc8      |
+------------+--------------+-----------+

【讨论】：

感谢您的反馈。这看起来不错！我会测试一下。我还在熟悉 VBA，但是如何在 VBA 模块中调用 sub？我一直在寻找如何在模块中调用 VBA 子程序，但我很困惑。我在 Sub 下打了一个电话，它抛出一个错误，说只有 cmets 可以跟随 End Sub。再次感谢！:)

没关系，我将尝试将它作为宏中的函数运行（这行得通吗？）。我现在收到以下错误：“无效使用 Null”。我试图找出这个 Null 值在哪里。有什么想法吗？

触发它的代码是：strPart = rs![PART FIND NO]

更新：注意到数据集中有一个空值。我修改了查询以排除空值。在另一个问题帖子中看到 VBA 中的字符串值不能为空。但是，现在我试图从宏 RunCode 运行该函数，但它什么也没做。它有什么问题？

另一个更新：我发现代码直接影响表本身。现在，我意识到我需要一种方法将每个 PART FIND NO 的第一个值重置为 1，因为运行 VBA 代码只会不断增加值。