访问VBA：消除FindFirst循环复制

Question

我有4个名为listMachine，listMachineSystem，listMachineSubSystem和listcompoenents的列表框。用户按照他的意愿从列表框中选择项目，并且将表格与从上述表格到新表格的ID一起填充，因为所有列表框都是分层连接的。问题在于，在tblcomponents中，选择的项目会在一个循环中流畅地遍布agao，而不是如何阻止它。我已经看到了下面的代码。任何人都可以帮我解决这个问题。

ID = DMax("[MAchine ID]", "tblmachine")
Dim sMachineSubsystem As String, varSelectedID11 As Variant
Dim vMaxMachineSubsystemID As Variant

Set db = CurrentDb()
Set rs = db.OpenRecordset("tblMachineSystem", dbOpenDynaset, dbAppendOnly)
Set rs1 = db.OpenRecordset("tblMachineSubSystem", dbOpenDynaset, dbAppendOnly)
Set rs2 = db.OpenRecordset("tblComponents", dbOpenDynaset, dbAppendOnly)


For n = 0 To Me.listMachineSystem.ListCount - 1
    If Me.listMachineSystem.Selected(n) Then
        rs.AddNew
        rs!MachineSystem = Me.listMachineSystem.Column(0, n)
        rs![MAchine ID] = ID
        rs!MO_TAG = Me.listMachineSystem.Column(3, n)
        rs!MachineSystem_Details = Me.listMachineSystem.Column(4, n)
        rs.Update
    End If
Next n

For i = 0 To Me.listMachineSubSystem.ListCount - 1
    If Me.listMachineSubSystem.Selected(i) Then
        rs.FindFirst "[Machine ID]=" & ID & " AND [MachineSystem]=  '" &   
            DLookup    ("[MachineSystem]", "tblMachineSystem", 
           "[Machine System ID]=" & Me.listMachineSubSystem.Column(2, i))  & "'"

        rs1.AddNew
        rs1![MachineSubsystem] = Me.listMachineSubSystem.Column(0, i)
        rs1![Machine Sytem ID] = rs![Machine System ID]
        rs1![MO_TAG] = Me.listMachineSubSystem.Column(3, i)
        rs1![MachineSubSystem_Details] = Me.listMachineSubSystem.Column(4, i)
        rs1.Update

        'add selected value(s) from listComponents to tblComponents
        For l = 0 To Me.listComponents.ListCount - 1
            If Me.listComponents.Selected(l) Then
                varSelectedID2 = Me.listComponents.Column(2, l)
                sMachineSubsystem = DLookup("[MachineSubsystem]", "tblMachineSubSystem", 
                     "[Machine Subsystem ID]=" & varSelectedID2)
                vMaxMachineSubsystemID = DMax("[Machine System ID]", "tblMachineSystem", 
                     "[Machine ID]=" & ID & " AND [MachineSystem]=  '" & 
                     DLookup("[MachineSystem]", "tblMachineSystem", "[Machine System ID]=" 
                     & rs![Machine System ID]) & "'")

                rs1.FindFirst "[Machine Sytem ID]=" & vMaxMachineSubsystemID & " 
                    AND [MachineSubsystem]=  '" & sMachineSubsystem & "'"
                If rs1.NoMatch Then
                    MsgBox "no records found"
                Else
                    Do While Not rs1.NoMatch
                        MsgBox "I found it!!!"
                        rs2.AddNew
                        rs2![Components] = Me.listComponents.Column(0, l)
                        rs2![Machine Subsystem ID] = rs1![Machine Subsystem ID]
                        rs2![MO_TAG] = Me.listComponents.Column(3, l)
                        rs2![Components_Detail] = Me.listComponents.Column(4, l)
                        rs2.Update
                        rs1.FindNext "[Machine Sytem ID]=" & vMaxMachineSubsystemID & " 
                          AND [MachineSubsystem]=  '" & sMachineSubsystem & "'"
                    Loop
                End If
            End If
        Next l
    End If
Next i