グループ毎連番を自動入力する関数

SetSequenceNumber

'グループ毎の連番を入力する関数
'指定の待機時間、ダイアログボックスを表示し、残り秒数カウントダウンします。
'引数　FieldName：連番を格納するフィールド名(データ型は数値型)
'　　　TableName：対象のテーブル名またはクエリ名(パラメータクエリは不可)
'　　　GroupBy：グループ化するフィールド名（省略可能）
'               複数フィールドをカンマ区切りで指定可能
'               省略した場合は全レコードを通しての連番になります。
'　　　Orderby：並べ替えするフィールド名（省略可能）
'               SQLのORDER BY句内の式と同一
'               省略した場合は並び順は不定になります。
'　　　WhereCondition：抽出条件式（省略可能）
'               SQLのORDER BY句内の式と同一
'               省略した場合は並び順は不定になります。
'使用上の注意： 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 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

    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 strOrderby = strSQL & "," & WhereCondition
    If LenB(Orderby) > 0 Then strOrderby = strOrderby & "," & Orderby
    If LenB(strOrderby) > 0 Then strSQL = strSQL & " ORDER BY " & Mid$(strOrderby, 2)
    strSQL = strSQL & ";"
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

    On Error GoTo ErrHdl

    'グループ化するフィールド数分の動的配列確保
    GCnt = UBound(Split(GroupBy, ","))
    If GCnt > -1 Then ReDim v(GCnt)
    '連番書き込みループ
    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
    Loop

Ext:
    rs.Close
    Set rs = Nothing
    Exit Function
ErrHdl:
    MsgBox Err & "：" & Err.Description
    SetSequenceNumber = False
    Resume Ext
End Function

Usage

'使用例
If SetSequenceNumber("SequenceNum", "Tbl1", "Group1,Group2", "Data1,ID") Then
     MsgBox "完了"
End If

If SetSequenceNumber("SequenceNum", "Tbl1", , "Data1,ID", "Group1=1 And Group2=1") Then
     MsgBox "完了"
End If

If SetSequenceNumber("SequenceNum", "Tbl1", , "Data1 DESC,ID") Then
     MsgBox "完了"
End If