Microsoft Access 掲示板

リンク先から転載

'グループ毎の連番を入力する関数
'引数　FieldName：連番を格納するフィールド名(データ型は数値型)
'　　　TableName：対象のテーブル名またはクエリ名(パラメータクエリは不可)
'　　　GroupBy：グループ化するフィールド名（省略可能）
'               複数フィールドをカンマ区切りで指定可能
'               省略した場合は全レコードを通しての連番になります。
'　　　Orderby：並べ替えするフィールド名（省略可能）
'               SQLのORDER BY句内の式と同一
'               省略した場合は並び順は不定になります。
'　　　WhereCondition：抽出条件式（省略可能）
'               SQLのOWHERE句内の式と同一
'               省略した場合は全レコードが対象になります。
'使用上の注意： DAO ライブラリへの参照設定が必要です。
Public Function SetSequenceNumber( _
       FieldName As String, _
       TableName As String, _
       Optional GroupBy As String, _
       Optional Orderby As String, _
       Optional WhereCondition As String) As Boolean
    Dim ws As DAO.Workspace
    Dim rs As DAO.Recordset
    Dim c As Long, GCnt As Long, i As Long
    Dim strSQL As String, strOrderby As String
    Dim v() As String
 
    Const CommitInterval As Long = 5000 'トランザクションをコミットする間隔
    Dim TranCount As Long
    Dim TranBegin As Boolean
    On Error GoTo ErrHdl
 
    SetSequenceNumber = True
 
    'SQL文生成
    strSQL = "SELECT " & FieldName
    If LenB(GroupBy) > 0 Then
        strSQL = strSQL & ", " & GroupBy
        strOrderby = "," & GroupBy
    End If
    strSQL = strSQL & " FROM " & TableName
    If LenB(WhereCondition) > 0 Then strSQL = strSQL & " WHERE " & WhereCondition
    If LenB(Orderby) > 0 Then strOrderby = strOrderby & "," & Orderby
    If LenB(strOrderby) > 0 Then strSQL = strSQL & " ORDER BY " & Mid$(strOrderby, 2)
    strSQL = strSQL & ";"
     
    Set ws = DBEngine.Workspaces(0)
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
 
    'グループ化するフィールド数分の動的配列確保
    GCnt = UBound(Split(GroupBy, ","))
    If GCnt > -1 Then ReDim v(GCnt)
 
    '連番書き込みループ
    TranCount = 0
    ws.BeginTrans: TranBegin = True
    Do Until rs.EOF
        For i = 0 To GCnt
            If v(i) = rs(i + 1) Then
            Else
                c = 0
                v(i) = rs(i + 1)
            End If
        Next
        c = c + 1
        rs.Edit
        rs(0) = c
        rs.Update
        rs.MoveNext
        '↓対象レコード件数が多い時に共有ロック数エラーが出る時の対策用
        TranCount = TranCount + 1
        If TranCount = CommitInterval Then
            ws.CommitTrans
            ws.BeginTrans
            TranCount = 0
        End If
    Loop
    ws.CommitTrans: TranBegin = False
 
Ext:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Set ws = Nothing
    Exit Function
ErrHdl:
    MsgBox Err & "：" & Err.Description
    SetSequenceNumber = False
    If TranBegin Then ws.Rollback
    Resume Ext
End Function

上記のコードをコピーして標準モジュールに貼り付けましたか。