AccessVBA Do Loop グループ内のナンバリング(連番)設定 共有ロックエラー退避含む
元のレコード内のグループ内で連番を設定する。
新たなテーブルに連番を降ったレコードを追加してみた。
<元データ>
<追加後の完成イメージ>
商品ごと日付ごとに順位付けを行い、連番を振ったフィールドを追加した。
回数フィールドに追加した連番を記述してある。
以下、VBAの記述
'------------------------------------------------------------------------------
Public Function createCount2()
Dim ws As Workspace
Dim db As Database
Dim rst As Recordset
Dim rst1 As Recordset
Dim strSQL As String
Dim strCode As String
Dim i As Integer
Dim cnt As Integer
DoCmd.SetWarnings False
’追加先のテーブルデータを消去
DoCmd.RunSQL "DELETE*FROM CountTbl2;"
'大量のデータを処理する場合、共有ロックエラーが起きるためその退避
Set ws = DBEngine.Workspaces(0)
Set db = CurrentDb
'商品ごと日付ごとにソートをかける
strSQL = "SELECT originTbl.* FROM originTbl ORDER BY originTbl.商品 ASC, originTbl.日付 ASC;"
Set rst1 = db.OpenRecordset(strSQL, dbOpenSnapshot)
Set rst = db.OpenRecordset("CountTbl2")
If rst1.RecordCount <> 0 Then
ws.BeginTrans
i = 0
Do Until rst1.EOF
rst.AddNew
rst!日付 = rst1!日付
rst!商品 = rst1!商品
rst!数量 = rst1!数量
If strCode = rst1!商品 Then
i = i + 1
Else
strCode = rst1!商品
i = 1
End If
rst!回数 = i
cnt = cnt + 1
If cnt = 5000 Then
ws.CommitTrans
ws.BeginTrans
cnt = 0
End If
rst.Update
rst1.MoveNext
Loop
ws.CommitTrans
rst.Close
rst1.Close
db.Close
Set db = Nothing
ws.Close
Set ws = Nothing
End If
End Function
'------------------------------------------------------------------------------------------
以上、終わり。
大量データを処理する場合(10000レコード前後?)共有ロックエラーが出るので、
そのエラーを退避するための処理をリンクを参考に追加。
トランザクション処理(DAO): アクセスVBA エクセルVBA 備忘録
AccessVBA Do Loop 処理回数をレコード内容によって繰返し処理を行う
レコード内容によって処理(追加)を繰り返し行う。
Do〜Loop構文を使って行ってみた。
<元データ>
<追加後の完成イメージ>
ここでは数量フィールドの内容によって、例えば数量=1だと1回、数量=2だと2回レコードの追加処理を行っている。
繰り返し追加した回数をカウントフィールドに記述してある。
以下、VBAの記述
'-------------------------------------------------------------------------------------------
Public Function createCount()
Dim db As Database
Dim rst As Recordset
Dim rst1 As Recordset
Dim strSQL As String
Dim i As Integer
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE*FROM CountTbl;" '追加するテーブルデータを消去
Set db = CurrentDb
strSQL = "SELECT originTbl.* FROM originTbl;"
Set rst1 = db.OpenRecordset(strSQL, dbOpenSnapshot) '追加元のテーブル
Set rst = db.OpenRecordset("CountTbl") '追加先のテーブル
If rst1.RecordCount <> 0 Then
i = 0
Do Until rst1.EOF
rst.AddNew
i = i + 1 'カウンタ
rst!日付 = rst1!日付
rst!商品 = rst1!商品
rst!数量 = rst1!数量
rst!カウント = i
rst.Update
If i < rst1!数量 Then 'カウンタが数量未満なら同一レコードを繰り返し追加
rst1.Move 0
Else
rst1.MoveNext 'カウンタが数量と同数なら次のレコードへ移る
i = 0
End If
Loop
rst.Close
rst1.Close
db.Close
Set db = Nothing
End If
End Function
'----------------------------------------------------------------------------------------------
以上、終わり
ちなみに
MoveNext : 次のレコード
MovePrevious:1つ前のレコード
MoveLast:最終のレコード
MoveFirst:最初のレコード
参考資料
【Access備忘録】01
Microsoft OfficeアプリケーションのAccessはちょっとしたDB管理にとっても便利ですね。
先日SQLの基礎を学ぼうと思い立ち、↓の書籍を購入しSQL構文をふむふむと勉強していたら、これってAccessにも使えるかもと思い試してみました。
データをインポートした時にNull値や空白があったりでその後の加工作業が面倒だったりすることがあります。
Null値や空欄をゼロにしたい、そんな時に使えそうなコードです。
function Test()
Docmd.RunSQL "UPDATE '更新したいテーブル' SET '更新したいテーブル'=0 ,_
where IsNull('更新したいテーブル') or Len('更新したいテーブル')=0
もちろん更新クエリを使えばゼロに補正できるのですが、インポート作業と併せて
行えば楽ちんかもしれません。