[三流君] −−＞
[ＶＢＡで楽しく] −−＞
[バックナンバー一覧]
−−＞ No.130 Access クエリーをExcelシートへ10行x3列で出力する
Access クエリーをExcelシートへ10行x3列で出力する
メルマガ発行内容
＜Access クエリーをExcelシートへ10行x3列で出力する＞
どうも、三流プログラマーのＫｅｎ３です。
最近、質問もらうけど、
なかなか、解答できてない三流プログラマーのＫｅｎ３です。
※私のレベルで手に余る高度な質問が多くて。
今回の、サンプルファイルは、
http://www.ken3.org/vba/lzh/vba130.lzh
にdb130.mdb(Access2000版)が保存されています。
※クエリーやプログラムをいじって、遊んでみてください。
/*
* １. 今回のキッカケ
*/
郵便番号の集計システムを題材にして最近メルマガ書いてます。
[No.127 要求を聞き、疑問点をつぶし、仕様書を書く]
http://www.ken3.org/backno/backno_vba26.html#127
[No.128 AccessにExcelのシートをインポートする]
http://www.ken3.org/backno/backno_vba26.html#128
[No.129 Access いろいろとクエリーでグループ集計をしてみる]
http://www.ken3.org/backno/backno_vba26.html#129
前回、
データを集計するクエリーまで、なんとかやりました。
パターン１ Q_YUBIN_7
郵便番号７桁（−付で８桁）、カウント１０以上
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
郵便番号 郵便番号のカウント 桁数
220-0021 14 8
---
条件は >=10(10以上) で =8(桁数は8桁)
↑設定・実行結果イメージ
パターン２ Q_YUBIN_ETC
郵便番号７桁以外（−付で８桁以外）、カウント１０以上
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
郵便番号 郵便番号のカウント 桁数
232 11 3
---
条件は >=10(10以上) で <>8(桁数はNot 8桁)
↑設定・実行結果イメージ
パターン３ Q_YUBIN_1to9
カウント数が１０以下（１〜９）郵便番号が何桁であろうが
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
郵便番号 郵便番号のカウント 桁数
194-0012 1 8
228 1 3
700-0941 1 8
---
条件は <10 (10以下) で (桁数の条件は無し)
↑設定・実行結果イメージ
今回は、このクエリーを元に、データを出力してみたいと思います。
/*
* ２．方針を考える
*/
Q_YUBIN_7 : 郵便番号７桁（−付で８桁）、カウント１０以上
Q_YUBIN_ETC : 郵便番号７桁以外（−付で８桁以外）、カウント１０以上
Q_YUBIN_1to9 : カウント数が１０以下（１〜９）郵便番号が何桁であろうが
と３つのクエリーが存在します。
ここから、２つのシートを作るんだけど、さて、どうしましょう・・・
シートだけ作るなら、
^^^^^^^^^^^^^^^^^^^^
昔の自分のメルマガサンプルを見てみると、
＜Access97からExcel形式へExport時に書式設定を行いたい＞
http://www.ken3.org/backno/hosoku/e025/index.html
で、
DoCmd.TransferSpreadsheet acExport, 5, "管理MST", "C:\TEST.XLS", True, ""
＜書式付きエクスポート DoCmd.OutputToで、できます＞
http://www.ken3.org/backno/hosoku/ETC_026.html
で、
DoCmd.OutputTo acOutputTable, "T_管理MST", acFormatXLS, "C:\TEST.xls", True
を使ってました。
DoCmd.TransferSpreadsheet
や
DoCmd.OutputTo
で、AccessデータをExcelのシートに変換できるけど、
郵便番号 集計数 郵便番号 集計数 郵便番号 集計数
2280002 20 2600003 15 330005 20
2280003 15 2600004 20 330010 25
2280005 12 2600005 25 330015 12
みたいに、データをn列＊n行で出力できないので、
自分で、クエリーを読み込んで、
Excelへ出力してみたいと思います。
/*
* ３．ADOでクエリーを開いて、Excelへデータをセットする
*/
自分でレコードセットを開いて、出力かぁ・・・めんどいなぁ（オイオイ）
[No.93 Access2000 ADOでクエリーのレコードを参照 Excelへ出力]
http://www.ken3.org/backno/backno_vba19.html#93
で、
チョコット解説しているけど、
Recordset を開く場合
^^^^^^^^^^^^^^^^^^^^^
DAOだと、
Dim db as Database
Dim rs as DAO.Recordset
Set db = CurrentDB()
Set rs = db.OpenRecordset("Employees")
ADOだと、
Dim rs as New ADODB.Recordset
rs.Open "社員", CurrentProject.Connection, adOpenKeySet, adLockOptimistic
らしいので、
テストで、クエリー Q_YUBIN_7 を出力してみます。
CreateObject("Excel.Application")
で、
オブジェクト作成後、
Workbooks.Addで、Excelのブックを作成
Sheets.Addで、シートを追加して、
ActiveSheet.Name = "DATA" なんて感じで、.Nameプロパティを変更。
あとは、レコードセットを開いて、
ループでレコードエンドまでデータをセットしてます。
Private Sub btnTEST001_Click()
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim objEXCEL As Object 'Excel参照用
Dim nYLINE As Long 'セット位置
'Excelを起動する、オブジェクトの作成
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
objEXCEL.Visible = True 'Excelを見えるようにする
'新規のブックを追加する
objEXCEL.Workbooks.Add 'Excelのブックを作成
'Excelのシートを追加、シート名を変更する
objEXCEL.Sheets.Add 'シートを追加する
objEXCEL.ActiveSheet.Name = "DATA" 'シート名をDATAにする
'レコードセットを開く(Q_YUBIN_7)
rs.Open "Q_YUBIN_7", CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
'見出しの代入とカウンタの初期化
objEXCEL.Cells(1, "A") = "郵便番号"
objEXCEL.Cells(1, "B") = "件数"
nYLINE = 2 '２行目からデータをセットする
'レコードセットからExcelへデータをセットする
'ループ処理
While rs.EOF = False 'いつものEOFが偽の間
'データをセットする(Accessから転記)
objEXCEL.Cells(nYLINE, "A") = rs("郵便番号").Value
objEXCEL.Cells(nYLINE, "B") = rs("郵便番号のカウント").Value
'次を読む And カウンタを移動する
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
nYLINE = nYLINE + 1 'カウンタも忘れずに＋１する
Wend
'通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
End Sub |
まぁ、縦には、なんとかセットできたよね。
でも、これって？普通に出力した時と同じジャン？
A列 B列
郵便番号 件数
107-0052 27
112-0002 27
113-0033 28
135-0034 27
135-0044 27
136-0072 28
そうですよ（開き直りか？）
↑エクセルへのクエリー結果出力イメージ
/*
* ４．パズルは得意ですか？n列*n行の出力を考える
*/
さてと、n行になったら、となりの列を作成してみますか。
（作成って言うのか？たんにセット位置を移動というのか？）
いきなり考えるのは難しいので、手で表を自分で作ってみます。
データは
A列 B列
郵便番号 件数
107-0052 27
112-0002 27
113-0033 28
・
・
・
なんて感じを、１０行、３列にしてみると
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
(1) (2) (3) (4) (5) (6) (7) (8) (9)
n行目 A列 B列 C列 D列 E列 F列 G列 H列 I列
001行 郵便番号 件数 空白 郵便番号 件数 空白 郵便番号 件数 空白
002行 107-0052 27 160-0023 27 193-0833 27
003行 112-0002 27
・
・
・
011行 113-0033 28
012行 空白行-------------------- 空白行 ---------
013行 郵便番号 件数 空白 郵便番号 件数 空白 郵便番号 件数 空白
014行 107-0052 27 160-0023 27 193-0833 27
015行 112-0002 27
____________________________________________________________________
A列 B列 C列 D列 E列 F列 G列 H列 I列
(1) (2) (3) (4) (5) (6) (7) (8) (9)
１０行いったら次の列
３列貯まったら空白１行空けて頭に戻る(次ページ分）
そんなセット方法を考えてみる時、
まずは、
１０単位でデータを処理するので、
１１個目のデータは2行目D列(4)にセットされる。
ここをポイントにして、
次のレコードを読む
行カウンタ=行カウンタ+1
データカウンタ=データカウンタ＋１
したあと、
カウンタが１１だったら（１１になったら）
列を＋３する（A列の１からD列の4になる）
行を−１０する。
データカウンタを１に戻す
なんて、処理を入れると、１０レコード単位で次の行に進めそうです。
進めるけどさぁ、
３列進んだら、空白１行空けて頭に戻る(次ページ分）
は、どうするの？
そっか、列もカウントしないといけないのか・・・
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
カウンタが１１だったら（１１になったら）
列を＋３する（A列の１からD列の4になる）
列が9(３列)を越えたかチェックする
越えていれば：列をカウンタを１にして見出しを表示、行を増やす
越えていなければ:行を−１０する。
データカウンタを１に戻す
と、行が越えたかをチェックして、データをセットしてみます。
↑データセットのイメージ
プログラムを書くと、少し複雑だけど、
（まだまだ、改良の余地アリダケド）
nRCNT = nRCNT + 1 '処理レコード数を増やす
If nRCNT > 10 Then '処理したレコードが10を越えた(次の列)
nXLINE = nXLINE + 3 '次の列へカウンタを移動
If nXLINE > 9 Then '列が越えた？
nXLINE = 1 '1列目（Ａ列）に戻す
nYLINE = nYLINE + 2 '空白行にしたいのでセット位置を＋２する
Else
nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする
End If
'見出しの表示
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
nYLINE = nYLINE + 1 '見出し表示分行数が増えます
nRCNT = 1 '見出し表示後は１レコード目だよ
Else '
nYLINE = nYLINE + 1 '次の行へセット位置を移動
End If
で、なんとか、
セット位置を移動しながらデータをセルにセットすることが出来きました。
Private Sub btnTEST002_Click()
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim objEXCEL As Object 'Excel参照用
Dim nYLINE As Integer '行セット位置
Dim nXLINE As Integer '列セット位置
Dim nRCNT As Integer 'レコードカウンタ
'Excelを起動する、オブジェクトの作成
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
objEXCEL.Visible = True 'Excelを見えるようにする
'新規のブックを追加する
objEXCEL.Workbooks.Add 'Excelのブックを作成
'Excelのシートを追加、シート名を変更する
objEXCEL.Sheets.Add 'シートを追加する
objEXCEL.ActiveSheet.Name = "DATA" 'シート名をDATAにする
'レコードセットを開く(Q_YUBIN_7)
rs.Open "Q_YUBIN_7", CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
'カウンタの初期化 スタート位置のセット
nYLINE = 1 '１行目だよ
nXLINE = 1 '１列目（A列）だよ
'見出しをセットする
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
nYLINE = nYLINE + 1 '見出し分行数が増えます
nRCNT = 1 '見出し表示後は１レコード目だよ
'レコードセットからExcelへデータをセットする
'ループ処理
While rs.EOF = False 'いつものEOFが偽の間
'データをセットする(Accessから転記)
objEXCEL.Cells(nYLINE, nXLINE) = rs("郵便番号").Value
objEXCEL.Cells(nYLINE, nXLINE + 1) = rs("郵便番号のカウント").Value
'次を読む And カウンタを移動する
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
nRCNT = nRCNT + 1 '処理レコード数を増やす
If nRCNT > 10 Then '処理したレコードが10を越えた(次の列)
nXLINE = nXLINE + 3 '次の列へカウンタを移動
If nXLINE > 9 Then '列が越えた？
nXLINE = 1 '1列目（Ａ列）に戻す
nYLINE = nYLINE + 2 '空白行にしたいのでセット位置を＋２する
Else
nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする
End If
'見出しの表示
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
nYLINE = nYLINE + 1 '見出し表示分行数が増えます
nRCNT = 1 '見出し表示後は１レコード目だよ
Else '
nYLINE = nYLINE + 1 '次の行へセット位置を移動
End If
Wend
'通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
End Sub |
-【けんぞう！】---------------------------------------------------------
月500円、タバコなら２箱、120円缶コーヒーなら４缶分の謝礼をＧｅｔするなら
http://www.ken3.org/etc/500yen/ ←無料アンケート系の広告です。
『チッ、がんばって回答して月500円かよ』（お馬鹿なプログラマー：30歳）
------------------------------------------------------------------------
/*
* ５．終わりの挨拶
*/
今回は、
クエリーをExcelのシートにセットする処理で、
１０行３列でデータをセットしてみました。
なんか、あまりスマートじゃなかったけど、
こんな方法もあるってことで。
今回の、サンプルファイルは、
http://www.ken3.org/vba/lzh/vba130.lzh
にdb130.mdb(Access2000版)が保存されています。
※クエリーをいじって、遊んでみてください。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
フィードバック
VBA系の→[掲示板]←を覗く、質問を書き込む
評価・感想
ページフッター(リンクや広告など)
[三流君(TOP ken3.org へ戻る)]
-- [VBA系TOPへ]
---- [VBA系バックナンバー目次へ移動]
------ [VBAでIEを操作 CreateObject("InternetExplorer.application")]・・・実は当店一番人気、VBAでIEを操作するサンプルです
------ [VBAでOutlookの操作 CreateObject("Outlook.Application")]・・・Outlookを使い、メール関係の処理です
------ [Access から Excel 連携 CreateObject("Excel.Application")]・・・人気のAccessからExcelへデータ書き出しなどです
------ [AccessのUserForm/サブフォームを操作]・・・アクセスでフォームを使ったサンプルです
------ [Accessのレポートを操作]・・・レポートを操作してみました
------ [Access クエリー関係やその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です
------ [Excel UserForm(ユーザーフォーム)を操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
------ [ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
------ [Excel関係 関数、その他]・・・その他Excel関係です
------ [VBAでテキストファイル(*.txt,*.html,*.csv)の操作]・・・テキストファイルを使ったサンプルです
------ [VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます
広告
-- [通販系の売れ筋広告へ] ←主に楽天やAmazonのランキングです
blog
-- [三流君の作業日記] ← 日々の作業を少々
-- [通販あしあと] ← 通販ページの足跡を一覧で羅列
情報を探す
情報を探すならGoogleかな？
↓Web全体、サポート情報(support.microsoft.com)や三流君VBA(ken3.org)から検索する
書籍の購入
Webだけじゃさすがに勉強しきれないので、プログラミング関係の書籍も読んでみては？？
コンピュータ書籍の発送がハヤイ専門店
 コンピュータの本・専門店
|
※種類が豊富で探し易いです。※在庫ありが48時間以内発送が急ぎで資料や書籍がほしい時、とても助かります。
お奨め本の目次を見るだけでも勉強になったり
|
amazon.co.jpでキーワード別チェック
下記、私が設定したキーワードですが、こんな感じで資料や書籍を探ってみては？
[VBA全体を把握する] -- やはり全体をさらっと見たいですよね。
[SQL関連でＤＢ力UP] -- システムはデータベース設計が重要
[ADO接続を探る] -- VBAなのでADO接続を押さえておく
[Windows APIを探る] -- さらにAPIになて知ってれば強力だ！
[.NETを探る] -- と言っても時代は.NETに流れてるし
プログラミング以外でも知りたいことは多くって、
[人間関係] -- で、客先・上司、まわりに気を使い。
[プログラマーの自己啓発] -- プログラムだけじゃなくいろいろと向上したいよ
[コーチング・育成] -- 先輩になったら後輩(部下)の面倒をみてね。
そんなこんなでプログラマーっていろいろと大変なんだってば・・・