ADO read-only queryとDictionaryを使う前に、端末がどの実装を呼び、どの対象を読むかを確認してください。Excel VBAでデータベースとExcelのデータの差分を効率的に確認する方法の結論は「DBから必要列だけをread-onlyで取得し、主keyでdictionary化してExcel tableと照合します。SELECT *と行番号対応を避け、DBのみ、Excelのみ、値違いの三種類へ分類します。」。行順で比較せずunique keyで対応付け、NULL、date、decimal、caseの比較ruleを定義する環境で、未確認の変更を避けるための順番を示します。 確認ポイント：差分の意味はkey一意性、比較cutoff、Nullと文字列の正規化規則を固定して初めて確定します。
Excel表とDB queryの比較範囲を同じcutoffへ揃える
Excelとデータベースの差分確認では、両方に共通する一意キー、比較列の型、Nullと空文字の扱いを先に定義します。ADOは読み取り専用クエリに限定し、キー重複を検出した時点で比較を止めます。Excelのみ、DBのみ、値不一致を別分類にし、キーと双方の値を並べて再照合できる形で出力します。
- 比較keyの一意性とNULL可否を確認する
- DB snapshot時刻とExcel更新時刻を固定する
- 列型、timezone、decimal精度、文字列正規化ruleを決める
- read-only accountとparameterized queryを使う
主キーdictionaryから三種類の差分を作る
Excel側の空keyと重複keyを拒否する
Sub CheckKeys()
Dim t As ListObject, r As Range, d As Object
Set t=ThisWorkbook.Worksheets("Data").ListObjects("tblData")
Set d=CreateObject("Scripting.Dictionary")
For Each r In t.ListColumns("ID").DataBodyRange
If d.Exists(CStr(r.Value2)) Then Debug.Print "Duplicate", r.Address Else d.Add CStr(r.Value2), True
Next r
End Sub重複解消前に差分判定へ進みません。
parameter queryで必要列だけ取得する
sql = "SELECT id, name, updated_at FROM dbo.target WHERE updated_at >= ?"
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = cn
cmd.CommandText = sql
cmd.Parameters.Append cmd.CreateParameter("p1", adDBTimeStamp, adParamInput, , cutoff)
Set rs = cmd.Execute定数はearly bindingまたは明示値を管理し、接続文字列へsecretを直書きしません。
DB keyを重複なしのdictionaryへ格納する
Do Until rs.EOF
key=CStr(rs.Fields("id").Value)
If db.Exists(key) Then Err.Raise vbObjectError+1,,"DB key duplicate"
db.Add key, Array(rs.Fields("name").Value,rs.Fields("updated_at").Value)
rs.MoveNext
Loop行順ではなくkeyを使います。
ExcelOnly・DbOnly・ValueDifferentを判定する
If Not db.Exists(key) Then
status="ExcelOnly"
ElseIf Normalize(excelName) <> Normalize(db(key)(0)) Then
status="ValueDifferent"
Else
status="Match"
End IfNormalizeのruleを文書化し原値も残します。
Diff sheetへ比較値と時刻を出力する
' Diff sheetへ Key, Status, ExcelValue, DbValue, ComparedAt を出力
' source sheetやDBへUPDATEしない差分確認と同期更新を分離します。
read-only connectionでも出力sheetは別途保護する
接続はread-only account、SELECT限定で行い、credentialをworkbook cellやVBA sourceへ保存しません。production DBへUPDATE/DELETEしません。Excelもsource tableを上書きせずDiff sheetへ出します。macro前にworkbook backupを取り、接続error時はrecordset/connectionを閉じ、作業結果だけを破棄します。
Null・大文字小文字・日時境界を固定する
行番号比較はsort/filterで破綻します。NULLと空文字、trailing space、case、full-width、date timezone、floating pointの差を仕様化します。snapshot時刻がずれると正しい更新を差分と誤認します。DBとExcelのどちらを正とするかは差分検出後のbusiness判断です。
全件一致を差分0件として扱う
- 行順で比較する
- SELECT *を使う
- 接続文字列へpasswordを書く
- NULLと空文字を同一視する
- 差分検出と同期更新を同時に行う
key集合と差分件数を最終照合する
Excel件数、DB件数、Match/ExcelOnly/DbOnly/ValueDifferent合計、key重複、parse errorを照合します。既知5caseのtest database/copyで期待statusを確認し、同一snapshotの再実行で結果が変わらないことを確認します。
DB差分確認を合格とする条件
接続文字列とcutoffは呼出側から引数で渡し、read-only ADO Commandのparameter queryでDB行を取得します。DB/Excelをunique IDのdictionaryへ入れ、ExcelOnly、DbOnly、ValueDifferentを全方向に列挙する完成版を使います。
ADO読取比較を完結させるVBAコード
Option Explicit
Private Function NormalizeValue(ByVal value As Variant) As String
If IsNull(value) Or IsEmpty(value) Then
NormalizeValue = ""
Else
NormalizeValue = LCase$(Trim$(CStr(value)))
End If
End Function
Private Sub WriteDiff(ByVal ws As Worksheet, ByRef outRow As Long, ByVal key As String, _
ByVal state As String, ByVal excelValue As Variant, ByVal dbValue As Variant)
ws.Cells(outRow, 1).Value2 = key
ws.Cells(outRow, 2).Value2 = state
ws.Cells(outRow, 3).Value2 = excelValue
ws.Cells(outRow, 4).Value2 = dbValue
ws.Cells(outRow, 5).Value2 = Now
outRow = outRow + 1
End Sub
Public Sub CompareDatabaseToExcel(ByVal connectionString As String, ByVal cutoff As Date)
Const adCmdText As Long = 1, adParamInput As Long = 1
Const adDBTimeStamp As Long = 135, adModeRead As Long = 1
Dim cn As Object, cmd As Object, rs As Object
Dim db As Object, seen As Object, excelKeys As Object, dbRow As Variant
Dim t As ListObject, lr As ListRow, ws As Worksheet, k As Variant
Dim key As String, excelName As Variant, updated As Variant, outRow As Long
On Error GoTo CleanFail
Set cn = CreateObject("ADODB.Connection")
cn.Mode = adModeRead
cn.Open connectionString
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = cn
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT id, name, updated_at FROM dbo.target WHERE updated_at >= ?"
cmd.Parameters.Append cmd.CreateParameter("p1", adDBTimeStamp, adParamInput, , cutoff)
Set rs = cmd.Execute
Set db = CreateObject("Scripting.Dictionary")
Set seen = CreateObject("Scripting.Dictionary")
Set excelKeys = CreateObject("Scripting.Dictionary")
Do Until rs.EOF
key = Trim$(CStr(rs.Fields("id").Value))
If Len(key) = 0 Or db.Exists(key) Then Err.Raise vbObjectError + 2101, , "Blank or duplicate DB key: " & key
db.Add key, Array(rs.Fields("name").Value, NormalizeValue(rs.Fields("name").Value))
rs.MoveNext
Loop
Set t = ThisWorkbook.Worksheets("Data").ListObjects("tblData")
Set ws = ThisWorkbook.Worksheets("Diff")
ws.Cells.ClearContents
ws.Range("A1:E1").Value = Array("Key", "Status", "ExcelValue", "DbValue", "ComparedAt")
outRow = 2
For Each lr In t.ListRows
updated = lr.Range.Cells(1, t.ListColumns("UpdatedAt").Index).Value
If Not IsDate(updated) Then Err.Raise vbObjectError + 2102, , "Invalid Excel UpdatedAt"
If CDate(updated) >= cutoff Then
key = Trim$(CStr(lr.Range.Cells(1, t.ListColumns("ID").Index).Value2))
If Len(key) = 0 Or excelKeys.Exists(key) Then Err.Raise vbObjectError + 2103, , "Blank or duplicate Excel key: " & key
excelKeys.Add key, True
excelName = lr.Range.Cells(1, t.ListColumns("Name").Index).Value
If Not db.Exists(key) Then
WriteDiff ws, outRow, key, "ExcelOnly", excelName, Empty
Else
dbRow = db(key)
seen(key) = True
If NormalizeValue(excelName) <> CStr(dbRow(1)) Then WriteDiff ws, outRow, key, "ValueDifferent", excelName, dbRow(0)
End If
End If
Next lr
For Each k In db.Keys
If Not seen.Exists(CStr(k)) Then
dbRow = db(k)
WriteDiff ws, outRow, CStr(k), "DbOnly", Empty, dbRow(0)
End If
Next k
Debug.Print "db=" & db.Count, "excel=" & excelKeys.Count, "differences=" & outRow - 2
CleanExit:
On Error Resume Next
If Not rs Is Nothing Then If rs.State <> 0 Then rs.Close
If Not cn Is Nothing Then If cn.State <> 0 Then cn.Close
Set rs = Nothing: Set cmd = Nothing: Set cn = Nothing
Exit Sub
CleanFail:
Debug.Print Err.Number, Err.Description
Resume CleanExit
End Subこのcodeは画面表示だけを見るための例ではありません。通常系では「両sourceのunique keyを読み、Matchを除く三差分がKey/ExcelValue/DbValue付きで出力される」を確認し、0件と実行errorを別の結果として保存します。
一致・片側のみ・値違いを分類する
- 期待どおり：両sourceのunique keyを読み、Matchを除く三差分がKey/ExcelValue/DbValue付きで出力される
- 0件・非適用：両方0件はNoRowsとして0差分を返し、取得失敗とは分ける
- 実行error：duplicate key、NULL rule不明、connection/query errorは比較開始前または該当rowで停止する
SELECT *や文字列連結SQLを使わず、必要列と? parameterを固定します。NormalizeValueの定義を省略せず、secretをworksheetやsource codeへ埋めません。cutoffがsnapshot範囲と一致するか業務側で確認します。
重複key・Null・cutoff同値を試験する
' Excel: A=alpha, B=beta / DB: A=ALPHA, C=gamma をsampleにし、
' case-insensitive ruleではExcelOnly=B、DbOnly=C、ValueDifferent=0になることを確認する。Match、三差分、duplicate、NULL/blank、timezone境界、query 0件をtestします。DB snapshot時刻、cutoff、source件数、差分別件数、read-only connection modeを保存します。
Excel VBAでデータベースとExcelのデータの差分を効率的に確認する方法の証跡には、実行対象と取得時刻に加え、通常・0件・errorのどれへ分類したかを残します。通常系は「両sourceのunique keyを読み、Matchを除く三差分がKey/ExcelValue/DbValue付きで出力される」、停止系は「duplicate key、NULL rule不明、connection/query errorは比較開始前または該当rowで停止する」を判断文としてそのまま作業票へ写し、担当者ごとの言い換えで意味が変わらないようにします。
database差分を定期比較する場合は、Excel側の採取時刻とDB queryのcutoffを同じ基準時刻へ固定し、比較中に更新されたrecordを次回対象として分離します。stable keyごとにDBのみ、Excelのみ、値不一致を別tableへ出し、duplicate keyが一件でもあれば更新処理へ渡しません。connectionはread-onlyのまま閉じ、source別件数と未比較件数をrun IDへ残します。
コメント