あした

Sub renban_tenkai()

    Dim cn                  As ADODB.Connection
    Dim in_rs               As ADODB.Recordset		'INテーブル
    Dim ot_rs               As ADODB.Recordset		'OUTテーブル
    Dim lcounter            As Long
    Dim lstart              As Long
    Dim lend                As Long

    On Error GoTo ErrProc

    sSQL = "DELETE * FROM OUTテーブル;"			'OUTテーブルを削除
    CurrentDb.Execute sSQL

    Set cn = CurrentProject.Connection
    Set in_rs = New ADODB.Recordset
    Set ot_rs = New ADODB.Recordset
    
    in_rs.Open "INテーブル", cn, adOpenKeyset, adLockReadOnly		'INテーブル　読み取り専用で開く
    ot_rs.Open "OUTテーブル", cn, adOpenKeyset, adLockOptimistic	

    'SEQNOを振るためのKey初期化
    If Not in_rs.EOF Then
        s部品番号 = in_rs!部品番号
        iSEQNO = 0
    End If

    Do Until in_rs.EOF
        lstart = Val(in_rs!連番START)
        lend = Val(in_rs!連番END)
        
        For lcounter = lstart To lend

            'SEQNOを振るための制御
            If s部品番号 = in_rs!部品番号 And s客先製造日 = in_rs!客先製造日 Then
                iSEQNO = iSEQNO + 1
            Else
                s部品番号 = in_rs!部品番号
                s客先製造日 = in_rs!客先製造日
                iSEQNO = 1
            End If
            
            ot_rs.AddNew
            
            ot_rs!部品番号 = in_rs!部品番号
            ot_rs!客先製造日 = in_rs!客先製造日
            ot_rs!連番 = Format(lcounter, "000000")     '６桁
            ot_rs!SEQNO = iSEQNO
            
            ot_rs.Update
        Next
        in_rs.MoveNext
    Loop
    
    in_rs.Close: Set in_rs = Nothing
    cn.Close: Set cn = Nothing

Proc_Exit:
    DoCmd.SetWarnings 1
    Exit Sub
ErrProc:
    MsgBox Err.number & " " & Err.description
    Resume Proc_Exit
End Sub