プロが教えるわが家の防犯対策術!

access2002
excel2002

現在accessのクロス集計クエリで各店舗の損益表を作成しフォームからの出力指示でexcelにエクスポートしています。店舗番号を抽出条件にして1店舗ずつ出力しています。
これを店舗番号を指定せずクエリを実行し全店舗分の損益データを店舗ごとのシートに出力するようにしたいのですが、そんなことはできないでしょうか。

店舗,項目 ,8/1 ,8/2 ,8/3 ...
0001,売上 ,10000,12000,13000
0001,原価 , 5000, 5000. 6900
0001,人件費, 4000, 4500, 5000
0002,売上 ,20000,21000,19000
0002,原価 , 9000, 8900. 9000
0002,人件費, 6000, 7000, 6000
上記クエリ結果を
シート0001に
店舗,項目 ,8/1 ,8/2 ,8/3 ...
0001,売上 ,10000,12000,13000
0001,原価 , 5000, 5000. 6900
0001,人件費, 4000, 4500, 5000
シート0002に
店舗,項目 ,8/1 ,8/2 ,8/3 ...
0002,売上 ,20000,21000,19000
0002,原価 , 9000, 8900. 9000
0002,人件費, 6000, 7000, 6000

店舗ごとにクエリを作成すればできるような気がするのですが、店舗数が50以上あるのでどうにかひとつのクエリでできないものか考えたのですがどうしても分かりませんでした。
どなたかご存知の方がいらっしゃいましたらご教授願います。

A 回答 (7件)

Function makeXL()


'要参照設定 Microsoft DAO 3.x Object Library
Dim qDef As DAO.QueryDef
Dim strSQLa As String, strSQLb As String
Dim rs As DAO.Recordset

|strSQLa = "PARAMETERS [Forms]![F日付入力]![日付] DateTime;" _
|    & " TRANSFORM Sum(Q損益.Sales07) AS 売上の合計" _
|    & " SELECT Q損益.店舗, 項目マスタ.項目" _
|    & " FROM Q損益 INNER JOIN 項目マスタ ON Q損益.科目No = 項目マスタ.[No]"
|
|'WHERE (((Q損益.店舗)="0000000000001"))
|
|strSQLb = " GROUP BY Q損益.店舗, Q損益.科目No, 項目マスタ.項目" _
|    & " ORDER BY Q損益.科目No" _
|    & " PIVOT Format$([SalesDate],""yyyy/mm/dd(aaa)"");"
L__ここまででご質問者の作成したクエリからWhere句を除く部分をSQL文として変数に格納

Set rs = CurrentDb.OpenRecordset _
    ("select 店舗番号 from 店舗マスタ order by 店舗番号", dbOpenSnapshot)
__レコードセットの取得

    
For Each qDef In CurrentDb.QueryDefs
  If qDef.Name = "Q_TMP" Then
    DoCmd.DeleteObject acQuery, qDef.Name
  End If
Next qDef
__クエリの中に、「Q_TMP」が有れば削除

Set qDef = CurrentDb.CreateQueryDef("Q_TMP")
__クエリ「Q_TMP」の作成
  一個上でクエリの削除を行っていますが
  本来なら無ければ作成の方が良さそうですが・・手抜きの雰囲気

Do Until rs.EOF __レコードセットが、お終いまで繰り返す
  qDef.SQL = strSQLa _
  & " where Q損益.店舗 = '" & rs!店舗番号 & "'" _
  & strSQLb
  __上で変数に格納したSQL文にWhere句を追加し、クエリ「Q_TMP」
    のSQL文としています
    
  Debug.Print qDef.SQL
  __↑この辺でF9を押してブレークポイントを作成しAccessのウィンドウに
    戻ってクエリ「Q_TMP」が書き換わっているのを見てね
    また F8 で一行ずつ実行されますので変数などが変わって行くのも確認
    
  DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Q_TMP", _
    CurrentProject.Path & "\" & Format(Date, "yyyymm") & "outXL.xls", _
    True, rs!店舗番号
       '↑cstr(rs!店舗番号) かも?
  rs.MoveNext__次のレコードセットに移動
Loop__繰り返し

|rs.Close: Set rs = Nothing
|Set qDef = Nothing
|__このモジュールを抜けるときに白紙状態になるはずなのですが
   オマジナイです
MsgBox "お待たせ"
End Function

それぞれの関数やプロパティはカーソルを合わせて、F1 で該当するヘルプが出ますので
調べてください
私からはこれまでです。
自分で調べて覚えれば確実に自身の血となり肉(脳みそ)となります
がんばって下さい。
    • good
    • 0
この回答へのお礼

ありがとうございました。
自分でもいろいろ調べてみました。nicotinismさんの解説と合わせて少し理解できてきました。
少し手を加え、抽出条件を追加してみました。最初はうまくいかなかったのですが、いろいろ試しているうちにうまくいきました。
このたびは、ありがとうございました。

お礼日時:2006/08/23 12:20

多分、「店舗マスタ」のようなテーブルが有るでしょうから・・


「店舗マスタ」
店舗番号 テキスト型 主キーとして、レコードセットを取得して。

Function makeXL()
'要参照設定 Microsoft DAO 3.x Object Library
Dim qDef As DAO.QueryDef
Dim strSQLa As String, strSQLb As String
Dim rs As DAO.Recordset

strSQLa = "PARAMETERS [Forms]![F日付入力]![日付] DateTime;" _
    & " TRANSFORM Sum(Q損益.Sales07) AS 売上の合計" _
    & " SELECT Q損益.店舗, 項目マスタ.項目" _
    & " FROM Q損益 INNER JOIN 項目マスタ ON Q損益.科目No = 項目マスタ.[No]"

'WHERE (((Q損益.店舗)="0000000000001"))

strSQLb = " GROUP BY Q損益.店舗, Q損益.科目No, 項目マスタ.項目" _
    & " ORDER BY Q損益.科目No" _
    & " PIVOT Format$([SalesDate],""yyyy/mm/dd(aaa)"");"


Set rs = CurrentDb.OpenRecordset _
    ("select 店舗番号 from 店舗マスタ order by 店舗番号", dbOpenSnapshot)

For Each qDef In CurrentDb.QueryDefs
  If qDef.Name = "Q_TMP" Then
    DoCmd.DeleteObject acQuery, qDef.Name
  End If
Next qDef

Set qDef = CurrentDb.CreateQueryDef("Q_TMP")

Do Until rs.EOF
  qDef.SQL = strSQLa _
  & " where Q損益.店舗 = '" & rs!店舗番号 & "'" _
  & strSQLb
  Debug.Print qDef.SQL
  DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Q_TMP", _
    CurrentProject.Path & "\" & Format(Date, "yyyymm") & "outXL.xls", _
    True, rs!店舗番号
       '↑cstr(rs!店舗番号) かも?
  rs.MoveNext
Loop

rs.Close: Set rs = Nothing
Set qDef = Nothing
MsgBox "お待たせ"
End Function
    • good
    • 0
この回答へのお礼

出来ました!!
これはまさにプロの技だと思います。
ありがとうございます。本当に感謝いたします。
このプロシージャは非常にすばらしいので今後もいろいろと使用できると思います。
しかし悲しいかな、ここまでくると私にはどうにも理解できません。
そこでお願いなのですが、もし可能であるならば、このプロシージャについて簡単で結構ですので、少し解説していただけませんでしょうか。
厚かましいお願いかもしれませんが、よろしくお願いします。

お礼日時:2006/08/20 18:34

これで如何でしょう?



Function makeXL()
'要参照設定 Microsoft DAO 3.x Object Library
Dim qDef As DAO.QueryDef
Dim strSQLa As String, strSQLb As String
Dim numSheet As Integer

strSQLa = "PARAMETERS [Forms]![F日付入力]![日付] DateTime;" _
    & " TRANSFORM Sum(Q損益.Sales07) AS 売上の合計" _
    & " SELECT Q損益.店舗, 項目マスタ.項目" _
    & " FROM Q損益 INNER JOIN 項目マスタ ON Q損益.科目No = 項目マスタ.[No]"

'WHERE (((Q損益.店舗)="0000000000001"))

strSQLb = " GROUP BY Q損益.店舗, Q損益.科目No, 項目マスタ.項目" _
    & " ORDER BY Q損益.科目No" _
    & " PIVOT Format$([SalesDate],""yyyy/mm/dd(aaa)"");"


For Each qDef In CurrentDb.QueryDefs
  If qDef.Name = "Q_TMP" Then
    DoCmd.DeleteObject acQuery, qDef.Name
  End If
Next qDef

Set qDef = CurrentDb.CreateQueryDef("Q_TMP")

For numSheet = 1 To 50
  qDef.SQL = strSQLa _
  & " where Q損益.店舗 = '" & Format(numSheet, "0000000000000") & "'" _
  & strSQLb
  Debug.Print qDef.SQL
  
  DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Q_TMP", _
    CurrentProject.Path & "\" & Format(Date, "yyyymm") & "outXL.xls", _
    True, Format(numSheet, "0000000000000")
Next numSheet

Set qDef = Nothing
MsgBox "お待たせ"
End Function
    • good
    • 0
この回答へのお礼

で、で、できました!!
深夜までお付き合いいただき、ありがとうございました。
これができれば、もうOKとしたいところなのですが、今実行してみて気が付いたことがあります。
店舗番号は、1から50の連番ではないのです。番号が飛び飛びになっています。この場合はどのように対処したらいいのでしょうか。

暇なときで結構です。よろしくお願いします。

お礼日時:2006/08/18 02:23

クロス集計クエリは出来ていますよね?


でしたらそのクエリで、店舗が0001の抽出条件を設定したクエリを作成し
そのSQLビューを提示してみてください。

また
止まったときに、Ctrl + G を押してイミディエイトウィンドウを出して
そこに記述されているのも提示してください。

以上2点お願いします。

追伸、補足欄ですと当方で気が付かない場合がありますので
お礼欄に記述がありますと当方にメールが入りますので助かります。
    • good
    • 0
この回答へのお礼

たびたびすみません。
こちらがsqlです。

PARAMETERS [Forms]![F日付入力]![日付] DateTime;
TRANSFORM Sum(Q損益.Sales07) AS 売上の合計
SELECT Q損益.店舗, 項目マスタ.項目
FROM Q損益 INNER JOIN 項目マスタ ON Q損益.科目No = 項目マスタ.[No]
WHERE (((Q損益.店舗)="0000000000001"))
GROUP BY Q損益.店舗, Q損益.科目No, 項目マスタ.項目
ORDER BY Q損益.科目No
PIVOT Format$([SalesDate],"yyyy/mm/dd(aaa)");

こちらがイミディエイトウィンドウです。

PARAMETERS [Forms]![F日付入力]![日付] DateTime
TRANSFORM Sum(Q損益.Sales07) AS 売上の合計
SELECT Q損益.店舗, 項目マスタ.項目
FROM Q損益 INNER JOIN 項目マスタ ON Q損益.科目No=項目マスタ.[No]
WHERE (((Q損益.店舗)="0000000000001"))
GROUP BY Q損益.店舗, Q損益.科目No, 項目マスタ.項目
ORDER BY Q損益.科目No
PIVOT Format$([SalesDate],"yyyy/mm/dd(aaa)")

両者の違いは私には分かりませんでした。
ちなみに、クエリ『Q1』は単体では問題なく動きます。

よろしくお願いします。

お礼日時:2006/08/17 22:14

いけね


where 番号 =

where 店舗 =
ですね
後は大丈夫かな?
ただ今、酔って候
注、前回レスの時は「しらふ」なのに (^_^;)

勝手な言い草ですけど・・
回答の内容をヒントに調べてね

この回答への補足

回答ありがとうございます。
『番号』を『店舗』に変更しても構文エラーになってしまいます。他にもいろいろ試してみましたが、構文エラーはかわりませんでした。
何がいけなのでしょうか。

補足日時:2006/08/17 08:34
    • good
    • 0

お節介なMicrosoftでも単一のクエリでExcelのシートごとに分けて出力は出来ません。



VBA になりますが
クロス集計クエリの名前がQ1 、Q1 に抽出条件は指定していない、
店舗はテキスト型だとして
Where 句 を順次替えてやれば良いのでは?
下記を標準モジュールにコピペ
それをマクロからアクション → プロシージャの実行 『 プロシージャ名 makeXL() 』
とか、フォームにコマンドボタンを置いて呼び出すとか?

Function makeXL()
'要参照設定 Microsoft DAO 3.x Object Library
Dim qDef As DAO.QueryDef
Dim strSql As String
Dim numSheet As Integer

Set qDef = CurrentDb.QueryDefs("Q1")
strSql = Replace(qDef.SQL, ";", "")
Debug.Print strSql
Set qDef = Nothing

For Each qDef In CurrentDb.QueryDefs
  If qDef.Name = "Q_TMP" Then
    DoCmd.DeleteObject acQuery, qDef.Name
  End If
Next qDef

Set qDef = CurrentDb.CreateQueryDef("Q_TMP")

For numSheet = 1 To 50
  qDef.SQL = strSql & " where 番号 = '" & 店舗 & "'"
  DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Q_TMP", _
    CurrentProject.Path & "\" & Format(Date, "yyyymm") & "outXL.xls", _
    True, Format(numSheet, "0000")
Next numSheet
Set qDef = Nothing
msgbox "お待たせ"
End Function

※参照設定は、Alt + F11 でVBAのウィンドウが開きますので
ツール → 参照設定 で探して、
Microsoft DAO 3.6 Object Libraryにチェックを入れてください。

この回答への補足

丁寧な回答ありがとうございます。
早速マクロを作成しプロシージャを実行してみました。
すると
  qDef.SQL = strSql & " where 番号 = '" & 店舗 & "'"
この部分が、『PARAMETER句の構文エラー』 となってしまいました。何がいけないのでしょうか。
よろしくお願いします。

補足日時:2006/08/15 22:35
    • good
    • 0

フォームからの出力指示でExcelへエクスポートしているのであれば、フィルタかWhere条件を設定して、クロス集計クエリをOPEN

すればいいのでは??

この回答への補足

>フィルタかWhere条件を設定して、クロス集計クエリ
>をOPENすればいいのでは??

すみません。そう言われてもやり方がわかりません。具体的にどのようにしたらいいのでしょうか。
よろしくお願いします。

補足日時:2006/08/15 11:15
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

関連するカテゴリからQ&Aを探す