Excel Access操作

質問

お邪魔します。
Excelデータを使ってAccessで外部結合してExcelに戻すような
ことはマクロでできるのでしょうか。

データは同じブックにあります。

回答No.16

piroin654

コードの修正です。

受注一覧の支店名の並びの確定のためのSQL文の変更と、
受注売上比較一覧での受注一覧にデータが無いときに
売上一覧にデータが存在する場合の支店名の並びの
修正、および金額の不一致の場合の追加などのコードの変更を
しましたので、一部修正ではなく、修正したものも含めて
No15のコードを以下に差し替えてください。

Sub cmdMain()
　　Dim db As DAO.Database
　　Dim rs1 As DAO.Recordset
　　Dim rs2 As DAO.Recordset
　　Dim rs3 As DAO.Recordset
　　Dim rs4 As DAO.Recordset
　　Dim strSQL As String
　　Dim i As Long
　　Dim j As Long
　　Dim m As Long
　　Dim n As Long
　　Dim k As Long

　　'strSQLは支店名一覧の取得用
　　strSQL = "SELECT 受注一覧.支店名 FROM 受注一覧 GROUP BY 受注一覧.支店名 ORDER BY First(受注一覧.ID);"
　　Set db = CurrentDb
　　Set rs1 = db.OpenRecordset(strSQL, dbOpenDynaset)
　　Set rs2 = db.OpenRecordset("受注一覧")
　　Set rs3 = db.OpenRecordset("売上一覧")
　　Set rs4 = db.OpenRecordset("受注売上比較一覧", dbOpenDynaset)

　　'受注一覧のデータを受注売上比較一覧へ
　　If rs1.RecordCount > 0 Then
　　　　rs1.MoveFirst
　　　　Do Until rs1.EOF
　　　　　　rs2.MoveFirst
　　　　　　Do Until rs2.EOF
　　　　　　　　If rs1!支店名 = rs2!支店名 Then
　　　　　　　　　　rs3.MoveFirst
　　　　　　　　　　Do Until rs3.EOF
　　　　　　　　　　　　rs4.AddNew
　　　　　　　　　　　　　　rs4![商品名(A)] = rs2!商品名
　　　　　　　　　　　　　　rs4![金額(A)] = rs2!金額
　　　　　　　　　　　　　　For i = 0 To rs3.Fields.Count - 1
　　　　　　　　　　　　　　　　If rs2!支店名 = rs3.Fields(i).Name Then
　　　　　　　　　　　　　　　　　　'前もって支店名を売り上げ側の支店名のフィールドに入力
　　　　　　　　　　　　　　　　　　rs4![支店名(B)] = rs3.Fields(i).Name
　　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　Next i
　　　　　　　　　　　　　　rs4![商品名(B)] = rs2!商品名
　　　　　　　　　　　　rs4.Update
　　　　　　　　　　　　Exit Do
　　　　　　　　　　rs3.MoveNext
　　　　　　　　　　Loop
　　　　　　　　End If
　　　　　　rs2.MoveNext
　　　　　　Loop
　　　　rs1.MoveNext
　　　　Loop
　　End If

　　'売上一覧のデータを受注売上比較一覧へ
　　If rs3.EOF Then
　　　　Exit Sub
　　Else
　　　　rs3.MoveLast: rs3.MoveFirst
　　　　m = rs3.RecordCount
　　End If
　　n = 0
　　For j = 0 To rs3.Fields.Count - 1
　　　　If rs3.Fields(j).Name <> "ID" And rs3.Fields(j).Name <> "日付" And rs3.Fields(j).Name <> "コード" And rs3.Fields(j).Name <> "商品名" And rs3.Fields(j).Name <> "合計" Then
　　　　　　If rs3.Fields(j).Name <> "ID" And rs3.Fields(j).Name <> "日付" And rs3.Fields(j).Name <> "コード" And rs3.Fields(j).Name <> "商品名" And rs3.Fields(j).Name <> "合計" Then
　　　　　　　　rs3.MoveFirst
　　　　　　　　Do Until rs3.EOF
　　　　　　　　　　rs4.FindFirst "[商品名(B)]='" & rs3!商品名 & "' And [支店名(B)]='" & rs3.Fields(j).Name & "' And IsNull([金額(B)])"
　　　　　　　　　　If Not rs4.NoMatch Then
　　　　　　　　　　　　Do Until rs4.NoMatch
　　　　　　　　　　　　　　If rs4![支店名(B)] = rs3.Fields(j).Name Then
　　　　　　　　　　　　　　　　rs4.Edit
　　　　　　　　　　　　　　　　　　rs4![金額(B)] = rs3.Fields(j).Value
　　　　　　　　　　　　　　　　rs4.Update
　　　　　　　　　　　　　　End If
　　　　　　　　　　　　rs4.FindNext "[商品名(B)]='" & rs3!商品名 & "' And [支店名(B)]='" & rs3.Fields(j).Name & "' And IsNull([金額(B)])"
　　　　　　　　　　　　　　Exit Do
　　　　　　　　　　　　Loop
　　　　　　　　　　Else
　　　　　　　　　　　　If Not rs3.Fields(j).Value = 0 And Not IsNull(rs3.Fields(j).Value) Then
　　　　　　　　　　　　　　rs4.AddNew
　　　　　　　　　　　　　　　　rs4![商品名(B)] = rs3!商品名
　　　　　　　　　　　　　　　　rs4![金額(B)] = rs3.Fields(j).Value
　　　　　　　　　　　　　　　　rs4![支店名(B)] = rs3.Fields(j).Name
　　　　　　　　　　　　　　rs4.Update
　　　　　　　　　　　　End If
　　　　　　　　　　End If
　　　　　　　　　　n = n + 1
　　　　　　　　　　If m = n Then
　　　　　　　　　　　　Exit Do
　　　　　　　　　　End If
　　　　　　　　rs3.MoveNext
　　　　　　　　Loop
　　　　　　End If
　　　　End If
　　Next j

　　'不一致データの検索
　　rs4.MoveFirst
　　Do Until rs4.EOF
　　　　For k = 0 To rs4.Fields.Count - 1
　　　　　　If (rs4.Fields(k).Value = 0 Or IsNull(rs4.Fields(k).Value)) And (Not rs4.Fields(k).Name = "ID" And Not rs4.Fields(k).Name = "結果") Then
　　　　　　　　rs4.Edit
　　　　　　　　　　rs4!結果 = "不一致"
　　　　　　　　rs4.Update
　　　　　　End If
　　　　Next k
　　　　If (Not rs4![金額(A)] = 0 Or Not IsNull(rs4![金額(A)])) And (Not rs4![金額(B)] = 0 Or Not IsNull(rs4![金額(B)])) Then
　　　　　　If rs4![金額(A)] <> rs4![金額(B)] Then
　　　　　　　　rs4.Edit
　　　　　　　　　　rs4!結果 = "不一致"
　　　　　　　　rs4.Update
　　　　　　End If
　　　　End If
　　rs4.MoveNext
　　Loop

rs1.Close: Set rs1 = Nothing
rs2.Close: Set rs2 = Nothing
rs3.Close: Set rs3 = Nothing
rs4.Close: Set rs4 = Nothing
　　MsgBox "売上一覧の移動および受注売上比較一覧の作成終了"
End Sub

補足

No.11でご提示いただいた受注一覧と売上一覧を作成して実行してみたのですが
下記のコードでエラーが出ます。
エラー424です。
Variant 型にしたほうがよろしいのでしょうか。

＞Set db = CurrentDb

Micosoft DAO 3.6 object libraryはチェックすると「DLL読込時のエラーです」と
なりましたのでMicrosoft Office 16.0 Access databese engine Object Libraryに
チェック入れました。

ご指導いただけないでしょうか。
よろしくお願いします。