アクセスで、下記のテーブルを作成します。
テーブル名 テーブル1
フィールド
氏名 テキスト型
日付 日付/時刻型
数量 数値型
累計 数値型
ここにデータを読み込みます。この時点では累計は空白です。
下記の関数をコピーして標準モジュールに貼り付けます。
'累計を入力する関数
'引数 Expr:累計の対象となるフィールド名またはフィールドを使用した式
' FieldName:連番を格納するフィールド名(データ型は数値型または通貨型)
' TableName:対象のテーブル名またはクエリ名(パラメータクエリは不可)
' GroupBy:グループ化するフィールド名(省略可能)
' 複数フィールドをカンマ区切りで指定可能
' 省略した場合は全レコードを通しての連番になります。
' Orderby:並べ替えするフィールド名(省略可能)
' SQLのORDER BY句内の式と同一
' 省略した場合は並び順は不定になります。
' WhereCondition:抽出条件式(省略可能)
' SQLのOWHERE句内の式と同一
' 省略した場合は全レコードが対象になります。
' KeepInitialValue:先頭フィールドを初期値の設定(省略可能)
' True グループの先頭レコードの値を初期値として以降それに加算
' False 先頭レコードの累計値を0にリセットしてから加算(既定値)
'使用上の注意: DAO ライブラリへの参照設定が必要です。
Public Function SetCumulativeTotal( _
Expr As String, _
FieldName As String, _
TableName As String, _
Optional GroupBy As String, _
Optional Orderby As String, _
Optional WhereCondition As String, _
Optional KeepInitialValue As Boolean) As Boolean
Dim rs As DAO.Recordset
Dim ct As Currency, GCnt As Long, i As Long
Dim strSQL As String, strOrderby As String
Dim v() As String
Dim flgBreak As Boolean
On Error GoTo ErrHdl
SetCumulativeTotal = True
'SQL文生成
strSQL = "SELECT " & FieldName & ", " & Expr
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 rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
'グループ化するフィールド数分の動的配列確保
GCnt = UBound(Split(GroupBy, ","))
If GCnt > -1 Then ReDim v(GCnt)
'連番書き込みループ
flgBreak = True
Do Until rs.EOF
For i = 0 To GCnt
If v(i) = rs(i + 2) Then
Else
flgBreak = True
v(i) = rs(i + 2)
End If
Next
If flgBreak Then
flgBreak = False
If KeepInitialValue Then
ct = rs(0)
Else
ct = rs(1)
End If
Else
ct = ct + rs(1)
End If
rs.Edit
rs(0) = ct
rs.Update
rs.MoveNext
Loop
Ext:
On Error Resume Next
rs.Close
Set rs = Nothing
Exit Function
ErrHdl:
MsgBox Err & ":" & Err.Description
SetCumulativeTotal = False
Resume Ext
End Function
下記のコードを実行します。
If SetCumulativeTotal("数量","累計","テーブル1","氏名","日付") Then
MsgBox "完了"
End If
「完了」というメッセージボックスが表示されたら、テーブルに累計が書き込まれています。
「累計を入力する関数」でWEB検索するとより詳しい解説ページが見つかるかも。