从一个表中的地址列中查找出另一个表中的字符并将字符另存至另一列

Private Sub Command0_Click()
    Dim rs1 As New ADODB.Recordset
    Dim rs2 As New ADODB.Recordset
    Dim i, j As Long
    rs1.Open "镇区", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs2.Open "jdmz", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    For i = 1 To rs2.RecordCount
        For j = 1 To rs1.RecordCount
            If InStr(1, rs2("地址"), rs1("镇街"), 1) > 0 Then
                rs2!新地址 = rs1!镇街
                Exit For
            End If
            rs1.MoveNext
        Next
        rs1.MoveFirst
        rs2.MoveNext
    Next
    rs1.Close
    rs2.Close
    Set rs1 = Nothing
    Set rs2 = Nothing
End Sub