Question

我正在尝试比较MS Access中的两个数据数组-一个是从API GET生成的，另一个是从表的两列生成的。我正在使用双循环进行比较，我怀疑这不是最好的方法，但我仍在学习循环和数组的方法。我正在使用的代码如下：

Sub ParseList(ResCount As Long)

Dim db As DAO.Database
Dim rstConts As DAO.Recordset

Dim midstr As String, emailstr As String, Fname As String, Lname As String, SubStatus As String, echeck As String, Mecheck As String, ArrEcheck As String, ArrMecheck As String, MSub As String

Dim ArrResp() As String
Dim ArrConts() As Variant

Dim SubStart As Long, SubCount As Long, Fstart As Long, Fcount As Long, Lstart As Long, LCount As Long, Diffcount As Long, c As Long, i As Long, t As Long, y As Long, u As Long, v As Long

Dim IsSub As Boolean

Set db = CurrentDb
Udate = SQLDate(Now)

ReDim ArrResp(1 To ResCount, 1 To 4) As String

'This section parses a JSON response into an array
For i = 1 To ResCount
    midstr = ""
    emailstr = ""
    x = InStr(t + 2, GetListStr, "}}") + 21
    y = InStr(x + 1, GetListStr, "}}")
    If y = 0 Then
        Exit Sub
    End If
    midstr = Mid(GetListStr, x, y - x)
    emailstr = Left(midstr, InStr(midstr, ",") - 2)

    SubStart = InStr(midstr, "Status") + 9
    SubCount = InStr(InStr(midstr, "Status") + 8, midstr, ",") - SubStart - 1
    SubStatus = Replace(Mid(midstr, SubStart, SubCount), "'", "''")

    Fstart = InStr(midstr, ":{") + 11
    Fcount = InStr(InStr(midstr, ":{") + 11, midstr, ",") - (Fstart + 1)
    Fname = Replace(Mid(midstr, Fstart, Fcount), "'", "''")

    Lstart = InStr(midstr, "LNAME") + 8
    LCount = InStr(InStr(midstr, "LNAME") + 8, midstr, ",") - (Lstart + 1)
    Lname = Replace(Mid(midstr, Lstart, LCount), "'", "''")

    If SubStatus = "subscribed" Then
        MSub = "True"
        Else
        MSub = "False"
    End If

    ArrResp(i, 1) = emailstr
    ArrResp(i, 2) = MSub
    ArrResp(i, 3) = Fname
    ArrResp(i, 4) = Lname

    t = y
Next i

'This section grabs two columns from a database table and adds them to a second array
Set rstConts = CurrentDb.OpenRecordset("SELECT Primary_Email, EMailings FROM TBLContacts")
rstConts.MoveLast
rstConts.MoveFirst
c = rstConts.RecordCount

ReDim ArrConts(1 To c) As Variant
ArrConts = rstConts.GetRows(c)

'This loops through the JSON response array, and when it finds a matching value in the Table array it checks if a second value in the table array matches or not
For u = 1 To ResCount
    Debug.Print u
    echeck = ArrResp(u, 1)
    Mecheck = ArrResp(u, 2)
    For v = 0 To c
        If ArrConts(0, v) = "" Then
            Else
            ArrEcheck = ArrConts(0, v)
            ArrMecheck = ArrConts(1, v)
            If ArrEcheck = echeck Then
                If ArrMecheck = Mecheck Then
                    Debug.Print echeck & "Match"
                    Else
                    Debug.Print echeck & "No Match"
                End If
            End If
        End If
    Next v
Next u

MsgBox "Done"

End Sub

上面的代码根本无法完成，并且永远不会显示msgbox。末尾的debug.print行仅变为1，我不知道为什么。如果我从第二个循环部分中删除条件：

If ArrConts(0, v) = "" Then
Else
    ArrEcheck = ArrConts(0, v)
    ArrMecheck = ArrConts(1, v)
    If ArrEcheck = echeck Then
        If ArrMecheck = Mecheck Then
            Debug.Print echeck & "Match"
            Else
            Debug.Print echeck & "No Match"
        End If
    End If
End If

然后，我可以成功完成Main循环，并收到“完成”消息。但是我无法缩小第二个循环为何无法正确完成的原因，并且陷入困境。

Answer 1

由于数组的索引为零，因此需要从嵌套For循环的上限减去1，当循环超过记录限制时，该循环应该在随后的If行上抛出错误。 / p>

For u = 1 To ResCount
    Debug.Print u
    echeck = ArrResp(u, 1)
    Mecheck = ArrResp(u, 2)

    For v = 0 To c - 1                  ' REDUCE UPPER LIMIT BY 1
       If ArrConts(0, v) = "" Then      ' LINE NO LONGER SHOULD ERR OUT
       ...
    Next v
Next u

话虽如此，请考虑使用parsing JSON将VBA-JSON library移至MS Access表。然后使用SQL在表与表之间的基于集合的处理中使用JOIN和WHERE来检查值。这比在数组之间循环要有效得多。

MS Access VBA循环停止，没有错误或明显原因

1 个答案: