Excel Access操作

質問

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

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

回答No.15

piroin654

テーブルの設定
受注一覧、売上一覧にデータを設定しておきます。
売上一覧の各支店名は金額のフィールドですが、
Excelから都度インポートするので本来はフィールド数、
フィールド名は不定です。

　　　受注一覧
ID　　　　オートナンバー
日付　　　日付/時刻型
商品名　　テキスト型
数量　　　数値型
金額　　　数値型
支店名　　テキスト型

　　　売上一覧
ID　　　　　オートナンバー
日付　　　　日付/時刻型
コード　　　テキスト型
商品名　　　テキスト型
A支店　　　　数値型
B支店　　　　数値型
C支店　　　　数値型
D支店　　　　数値型
合計　　　　数値型

　　受注売上比較一覧
ID　　　　　　オートナンバー
商品名(A)　　　テキスト型
金額(A)　　　　数値型
結果　　　　　　テキスト型
商品名(B)　　　テキスト型
金額(B)　　　　数値型
支店名(B)　　　テキスト型

以下を標準モジュールに貼り付け実行してみてください。
なお、DAOを使用していますので、コード表のツールから
参照設定を選択し、
　　　Microsoft DAOxx Object Library
にチェックが入っているか確認してみてください。
xxは3.6のような数値です。Accessが64bit版で
なければ
Microsoft DAO3.6 Object Library
のチェックを確認してください。

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 受注一覧.支店名;"
　　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
　　rs3.MoveFirst
　　Do Until rs3.EOF
　　　　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
　　　　　　　　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
　　　　　　End If
　　　　Next j
　　　　n = n + 1
　　　　If m = n Then
　　　　　　Exit Do
　　　　End If
　　rs3.MoveNext
　　Loop

　　'不一致データの検索
　　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
　　rs4.MoveNext
　　Loop

rs1.Close: Set rs1 = Nothing
rs2.Close: Set rs2 = Nothing
rs3.Close: Set rs3 = Nothing
rs4.Close: Set rs4 = Nothing
End Sub

一応、動作は確認していますが、
分からないことがあれば補足してください。