Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1299 / 9994

←次へ　｜　前へ→


	【11993】二つのテーブルを比較する方法

KANA - 11/5/20(金) 9:09 -


	引用なし

	パスワード

二つのテーブル新TBLと旧TBLが存在します。
この二つのテーブルは全く同じ項目が載っているわけではないので、必要な項目列だけをチェックしたいと思っています

二つのデーブルを比較して、新と旧で中身が変更となっているものはどれなのか？を調べ、
変更TBLに変更を生じた箇所だけをリストアップしていきたいと思ってます。

下記のように作ってみたのですが、途中でどうしてもエラーとなってしまい、先へ進まず悩んでます。

If Mydic.Item(strKey)(u) <> MyVal2(u) Then ’←ココでエラーがでます。（オブジェクトが有効ではありません）

どうかご教授お願いします。
Dictionaryオブジェクトの使い方が間違っているのでしょうか？

Option Compare Database

Sub ChangeData()

'変更した箇所のチェック

Dim rs As ADODB.Recordset
Dim rst As ADODB.Recordset
Dim rsC As ADODB.Recordset
Dim MyVal, MyVal2, MyVal3, MyVal4
Dim lCnt As Long
Dim Mydic As Object
Dim Dic_Change As Object
Dim strKey As String
Dim DC As Long

Set Mydic = CreateObject("scripting.dictionary")
Set Dic_Change = CreateObject("scripting.dictionary")

Set rs = New ADODB.Recordset
　　rs.CursorType = adOpenKeyset
　　rs.LockType = adLockReadOnly

Set rst = New ADODB.Recordset
　　rst.CursorType = adOpenKeyset
　　rst.LockType = adLockReadOnly
　　
Set rsC = New ADODB.Recordset
　　rsC.CursorType = adOpenKeyset
　　rsC.LockType = adLockOptimistic

rs.Open "新TBL", CurrentProject.Connection, , adCmdTable
rst.Open "旧TBL", CurrentProject.Connection, , adCmdTable
rsC.Open "変更List", CurrentProject.Connection, , adCmdTable

旧TBLにデータがあったら差異箇所をチェック
DC = rst.RecordCount

If DC > 0 Then

’新TBLのデータをDictionaryオブジェクトを使用してデータを取得

rs.MoveFirst

Do Until rs.EOF
　strKey = rs![KEY]
If Not Mydic.Exists(strKey) Then
　 MyVal = Array(rs![F1], rs![F2], rs![F3], rs![F4], rs![F5], rs![F6], rs![F7], _
　　　　　　　 rs![F8], rs![F10], rs![F11], rs![F12], rs![F13], rs![F14], rs![F17])
　　　　　　　
　 Mydic.Add strKey, MyVal
　
　End If
　rs.MoveNext
Loop

rs.Close
Set rs = Nothing

’もし、新データと同じKeyがあったら、旧データを配列格納し、新データと旧データを比較し、違うものがあれば、新データの値を配列格納し、同じ場合は、””値を格納する
rst.MoveFirst

Do Until rst.EOF
　strKey = rst![KEY]
　If Mydic.Exists(strKey) Then
　　 MyVal2 = Array(rst![F2], rst![F3], rst![F4], rst![F5], rst![F6], rst![F7], rst![F8], _
　　　　　　　 rst![F10], rst![F11], rst![F12], rst![F13], rst![F14], rst![F15], rst![F16])
　　　　

　　　 If Mydic.Exists(strKey) Then
　　　　　For u = 0 To UBound(MyVal2)
　　　　　　
　　　　　　If Mydic.Item(strKey)(u) <> MyVal2(u) Then ’←ココでエラーがでます。（オブジェクトが有効ではありません）
　　　　　　　 lCnt = UBound(MyVal3)
　　　　　　　 ReDim Preserve MyVal3(lCnt)
　　　　　　　 MyVal3(lCnt) = Mydic.Item(strKey)(u)’新データを格納
　　　　　　 Else
　　　　　　　 lCnt = UBound(MyVal3)
　　　　　　　　ReDim Preserve MyVal3(lCnt)
　　　　　　　 MyVal3(lCnt) = ""　’空白を格納
　　　　　　　End If
　　　　　Next u
　　　 End If
　　　
　　 Dic_Change.Add strKey, MyVal3
　　
　　
　End If
　rst.MoveNext
Loop
rst.Close
Set rst = Nothing

Dim MyKey, MyItem

MyKey = Dic_Change.Keys
MyItem = Dic_Change.Items

For i = 0 To UBound(MyKey)
rsC.AddNew
　 MyVal4 = Array(rsC![F2], rsC![F3], rsC![F4], rsC![F5], rsC![F6], rsC![F7], _
　　　　　　　 rsC![F8], rsC![F9], rsC![F10], rsC![F11], rsC![F12], rsC![F13], rsC![F14], rsC![F15])
　
　 rsC![F1] = MyKey(i)
　 For u = 0 To UBound(MyVal4)
　　　rsC!MyVal4(u) = Dic_Change(MyKey(u))(u)
　 Next u
　 rsC.Update
Next i

　 rsC.Close
　 Set rsC = Nothing

Else

rs.Close
Set rs = Nothing
rst.Close
Set rst = Nothing
rsC.Close
Set rsC = Nothing

End If

End Sub

543 hits

▼

【11993】二つのテーブルを比較する方法 KANA 11/5/20(金) 9:09