アクセスまたは他のオフィスソフトで

質問

氏名　日付　数量
A　4/01　23
A　4/02　36
A　4/06　10
B　4/03　1
B　4/16　1
C　5/05　6
C　5/10　10
C　5/20　10
C　5/31　3

このようなデータが150万レコードあります。
数量の右側にその行までの累計値「Aの累計」「Bの累計」の列を加えたいのですが
どのようにしたらよろしいでしょうか。
レコード数が多くエクセルで処理できないので、アクセスになると思いますが
可能でしょうか。

回答No.1

hatena1989

アクセスで、下記のテーブルを作成します。

テーブル名　テーブル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検索するとより詳しい解説ページが見つかるかも。