Question

我正在使用DLookup搜索表中的字段。它可以正常运行，但是速度很慢。我有什么办法可以加快速度？

这是我现有的代码：

Me(k1) = Dlookup("[KLant]", "[Planning_tbl02]", "[Plek#]=" & p & " AND [datum]='" & Me(k4) & "'" & " AND [bezet_ochtend]='" & "bezet" & "'")

Answer 1

在表中要过滤的字段上

添加索引。

Answer 2

您可以编写自己的查找代码，以打开记录集并找到所需的值，例如：

Dim strCriteria As String, strQuery As String

strCriteria = _
    BuildCriteria("[Plek#]", dbLong, p) & " And " & _
    BuildCriteria("[datum]", dbDate, Me(k4)) & " And " & _
    BuildCriteria("[bezet_ochtend]", dbText, """bezet""")

strQuery = "SELECT [KLant] FROM [Planning_tbl02] WHERE " & strCriteria

With CurrentDb.OpenRecordset(strQuery, dbOpenForwardOnly)
    If Not .EOF Then
        Me(k1) = ![KLant]
    Else
        Me(k1) = Null
    End If
    .Close
End With

已添加：

在检查完您的代码后，我发现k2的奇数和偶数值的语句相差无几，因此我可以简化一下代码。另外，我发现k4仅对k2的奇数变化，这使数据库搜索的数量减半。这当然意味着下午不会有任何差异。最后，按照我的评论中的承诺，我将记录集的数量减少到30，并使用FindFirst搜索日期。这是我的结果：

Private Sub Form_Load()

    Dim p As Integer, k2 As Integer
    Dim k1 As String, k1_prev As String, k4 As String
    Dim r1 As Integer, g As Integer, b As Integer
    Dim strCriteria As String, strQuery As String

    For p = 1 To 30

        If r1 < 49 Then r1 = 255 Else r1 = r1 - 49
        If g > 203 Then g = 100 Else g = g + 52
        If b < 127 Then b = 160 Else b = b - 127

        strQuery = "SELECT [KLant], [datum] FROM [Planning_tbl02] WHERE " & _
            BuildCriteria("[Plek#]", dbLong, p) & " And " & _
            BuildCriteria("[bezet_ochtend]", dbText, """bezet""")

        With CurrentDb.OpenRecordset(strQuery, dbOpenDynaset)
            For k2 = 1 To 26

                k1_prev = k1
                k1 = "pl" & p & "_" & k2

                If k2 Mod 2 = 1 Then
                    k4 = "calday" & (k2 + 1) \ 2
                    .FindFirst BuildCriteria("[datum]", dbDate, Me(k4))
                    If .NoMatch Then Me(k1) = Null Else Me(k1) = ![klant]
                Else
                    Me(k1) = Me(k1_prev)
                End If

                If Not IsNull(Me(k1)) Then
                    If k2 = 1 Then
                        Me(k1).BackColor = RGB(r1, g, b)
                    Else
                        If Me(k1) <> Me(k1_prev) Then 'next color
                            If r1 < 49 Then r1 = 255 Else r1 = r1 - 49
                            If g > 203 Then g = 100 Else g = g + 52
                            If b < 127 Then b = 160 Else b = b - 127
                        End If
                        Me(k1).BackColor = RGB(r1, g, b)
                    End If
                End If

            Next
            .Close
        End With
    Next

End Sub

Answer 3

感谢您的答复。这是具有+/- 780个未绑定文本字段的表单，应使用表中的数据填充。我为一个小露营建立了一个程序，这种形式是每天可用空间的一种计划。因此，他们有30个地方，希望看到2个星期，所以有很多字段，因为他们还希望每天早上和下午分开。我知道，这可能不是正确的编程方式，但目前我的知识还不多：-（

因此，如果有人有好的建议，我将非常感谢。

有关完整代码，请参见下文，这是一个循环。

Private Sub Form_Load()

For p = 1 To 30
k2 = 1
k3 = 1

r1 = r1 - 49
g = g + 52
b = b - 127

If r1 < 0 Then r1 = 255
If g < 0 Then g = 200
If b < 0 Then b = 160

If r1 > 255 Then r1 = 31
If g > 255 Then g = 100
If b > 255 Then b = 56

For k2 = 1 To 26

k1 = "pl" & p & "_" & k2
k4 = "calday" & k3

If r1 < 0 Then r1 = 255
If g < 0 Then g = 200
If b < 0 Then b = 160

If r1 > 255 Then r1 = 31
If g > 255 Then g = 100
If b > 255 Then b = 56

If k2 Mod 2 = 1 Then

Dim strCriteria As String, strQuery As String
strCriteria = _
BuildCriteria("[Plek#]", dbLong, p) & " And " & _
BuildCriteria("[datum]", dbDate, Me(k4)) & " And " & _
BuildCriteria("[bezet_ochtend]", dbText, """bezet""")

strQuery = "SELECT [KLant] FROM [Planning_tbl02] WHERE " & strCriteria

With CurrentDb.OpenRecordset(strQuery, dbOpenForwardOnly)
If Not .EOF Then
 Me(k1) = ![klant]
 Else
Me(k1) = Null
End If
 .Close
End With 

If k2 = 1 Then

If Me(k1).Value <> "" Then
Me(k1).BackColor = RGB(r1, g, b)
End If
End If

If k2 - 1 > 0 Then

If Me(k1).Value <> "" And IsNull(Me("pl" & p & "_" & (k2 - 1)).Value) Then
Me(k1).BackColor = RGB(r1, g, b)
End If
End If

If k2 - 1 > 0 Then

If Me(k1).Value <> "" And Me("pl" & p & "_" & k2) = Me("pl" & p & "_" & (k2 - 1))Then
Me(k1).BackColor = RGB(r1, g, b)
End If
End If

If k2 - 1 > 0 Then

If Me("pl" & p & "_" & k2) <> Me("pl" & p & "_" & (k2 - 1)) Then
r1 = r1 - 49
g = g + 52
b = b - 127

Me(k1).BackColor = RGB(r1, g, b)
End If
End If
End If

If k2 Mod 2 <> 1 Then
strCriteria = _
BuildCriteria("[Plek#]", dbLong, p) & " And " & _
BuildCriteria("[datum]", dbDate, Me(k4)) & " And " & _
BuildCriteria("[bezet_ochtend]", dbText, """bezet""")

strQuery = "SELECT [KLant] FROM [Planning_tbl02] WHERE " & strCriteria

With CurrentDb.OpenRecordset(strQuery, dbOpenForwardOnly)
If Not .EOF Then
 Me(k1) = ![klant]
 Else
Me(k1) = Null
End If
.Close
End With

If Me(k1).Value <> "" And IsNull(Me("pl" & p & "_" & (k2 - 1)).Value) Then
Me(k1).BackColor = RGB(r1, g, b)
End If

If Me(k1).Value <> "" And Me("pl" & p & "_" & k2) = Me("pl" & p & "_" & (k2 - 1))Then
Me(k1).BackColor = RGB(r1, g, b)
End If

If k2 - 1 > 0 Then
If Me(k1).Value <> "" And Me("pl" & p & "_" & k2) <> Me("pl" & p & "_" & (k2 - 1)) Then
Me(k1).BackColor = RGB(r1, g, b)
End If
End If

If k2 - 1 > 0 Then

If Me("pl" & p & "_" & k2) <> Me("pl" & p & "_" & (k2 - 1)) Then
r1 = r1 - 49
g = g + 52
b = b - 127

If r1 < 0 Then r1 = 255
If g < 0 Then g = 200
If b < 0 Then b = 160

Me(k1).BackColor = RGB(r1, g, b)
End If
End If
End If

If k2 Mod 2 <> 1 Then
k3 = k3 + 1
End If

Next

Next

End Sub

DLookup是否有更快的替代方法来填写表单上未绑定的文本字段？

3 个答案: