|
私の一つ
'Microsoft DAO X.X Object Library 参照設定が必要です。
'http://www.accessclub.jp/actips/tips_32.htm
'シートA シートB Sheet3 が必要。
Sub DAO_001()
'*********************************************************************
' ExcelのシートとシートのSQL DAO 接続
'*********************************************************************
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = OpenDatabase(ThisWorkbook.FullName, False, False, "EXCEL 8.0;HDR=YES;")
strSQL = "SELECT シートA$.管理番号, シートA$.金額, シートB$.金額 " & _
"FROM [シートA$] INNER JOIN [シートB$] ON シートA$.管理番号 = シートB$.管理番号 " & _
"WHERE シートA$.金額<>[シートB$.金額];"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
Sheets("Sheet3").Range("A2").CopyFromRecordset rs
rs.Close
strSQL = " SELECT シートA$.管理番号, シートA$.金額, シートB$.金額 " & _
"FROM [シートA$] LEFT JOIN [シートB$] ON シートA$.管理番号 = シートB$.管理番号 " & _
"WHERE シートB$.金額 Is Null;"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
Sheets("Sheet3").Range("F2").CopyFromRecordset rs
rs.Close
strSQL = " SELECT シートB$.管理番号, シートB$.金額, シートA$.金額 " & _
"FROM [シートA$] RIGHT JOIN [シートB$] ON シートA$.管理番号 = シートB$.管理番号 " & _
"WHERE シートA$.金額 Is Null;"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
Sheets("Sheet3").Range("J2").CopyFromRecordset rs
rs.Close
db.Close
End Sub
|
|