Question

为实验室进行数据分析，我有一张失败的样本表以及他们可能失败的所有标准。尝试添加一个字符串，列出每个样本失败的标准。

我刚刚在2周前学习过VBA，所以我不知道自己在做什么。我使用记录集将我的表转换为数组，然后遍历每个记录以查看每个条件是否已失败并将其添加到新的故障数组（如果有）。然后我用一个丑陋的连接字符串打印出故障数组。记录少于100条，但它仍然非常慢，有时会崩溃Access。这是我的代码：

Option Compare Database
Option Explicit
Dim arrFails() As Variant
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim HType As Integer
Dim S As Integer

Public Sub MakeArrs()
    On Error GoTo ErrorHandler
    Set db = CurrentDb
     'Set rs = db.OpenRecordset("S" & HType & "RptSimple")

    Set rs = db.OpenRecordset("S31RptSimple")

    rs.MoveLast
    rs.MoveFirst
    S = rs.RecordCount - 1
    Debug.Print S
    Dim arrRpt() As Variant
    arrRpt = rs.GetRows(S + 1)
    Debug.Print arrRpt(0, 0)
    'This line creates an array arrFails with sample runs as rows, and 9 columns. Each column is a failure criteria.
    ReDim arrFails(0 To S, 0 To 8) As Variant


    Dim i As Long
    Let i = 0
    Dim index As Long
    'This For loop starts at the first record in arrRpt and goes across the row with an If loop for each of the failure criteria.
    'If the sample failed for that criteria, it populates the new arrFails array with the name of the criteria.
    'If the sample passed, that spot on the array stays null.
    'At the end of one loop, we have a row that ONLY has values for the criteria that failed.
    For index = 0 To S
        If arrRpt(2, i) < 0.85 Or IsNull(arrRpt(2, i)) = True Then
        arrFails(i, 0) = "Correlation, "
        End If
        If arrRpt(3, i) > -0.4 Or arrRpt(3, i) < -2 Or IsNull(arrRpt(3, i)) = True Then
        arrFails(i, 1) = "Slope, "
        End If
        If arrRpt(4, i) < 0.5 Or arrRpt(4, i) > 100 Or IsNull(arrRpt(4, i)) = True Then
        arrFails(i, 2) = "Slope_Ratio, "
        End If
        If arrRpt(5, i) < 2 Or IsNull(arrRpt(5, i)) = True Then
        arrFails(i, 3) = "Valid_Points, "
        End If
        If IsNull(arrRpt(6, i)) = False Then
        arrFails(i, 4) = "Fail_Code, "
        End If
        If arrRpt(7, i) < 1.5 Or arrRpt(7, i) > 10 Or IsNull(arrRpt(7, i)) = True Then
        arrFails(i, 5) = "DilutionRatio1, "
        End If
        If arrRpt(8, i) < 1.5 Or arrRpt(8, i) > 10 Or IsNull(arrRpt(8, i)) = True Then
        arrFails(i, 6) = "DilutionRatio2, "
        End If
        arrFails(i, 8) = arrRpt(0, i)
        i = i + 1

    Next

    rs.Close

    'This is error handling code, so if something goes wrong it'll gracefully exit the code instead of getting some poor user stuck in debug hell.
ExitSub:
        Exit Sub
ErrorHandler:
        MsgBox "There's been an error."
        Resume ExitSub
    Set rs = Nothing
    Set db = Nothing

End Sub

Public Function FailList2(HPVType, UIDFieldname)
    HType = HPVType
    Call MakeArrs
    Dim x As Variant
    x = 0
    Do While x < S + 1
    If UIDFieldname = arrFails(x, 8) Then
    FailList2 = arrFails(x, 1) & arrFails(x, 0) & arrFails(x, 2) & arrFails(x, 3) & arrFails(x, 4) & arrFails(x, 5) & arrFails(x, 6)
    Exit Do
    End If
    x = x + 1
    Loop
End Function

帮助新手出去？必须有一种更有效的方法来做到这一点。我尝试将echo关闭，直到FailList2函数结束，但它没有帮助。请注意，我需要保持＆＃39; Htype＆＃39;在功能中。我现在正在一张桌子上运行它，但是当我修复它时，我还有8个表来运行它，因此我在开头注释掉了rs代码。

Answer 1

我将该功能作为查询中的字段

糟糕，有问题。只需打开立即窗口，打开查询并观看Debug.Print语句滚动。该功能将一遍又一遍地执行。

您需要执行一次函数，将结果写入数组（arrFails），而不是写入表中。使用Recordset.AddNew添加记录。

然后使用该表作为查询的输入。

用于Access的VBA模块非常慢

1 个答案: