[三流君] −−> [VBAで楽しく] −−> [バックナンバー一覧]
−−> No.130 Access クエリーをExcelシートへ10行x3列で出力する

Access クエリーをExcelシートへ10行x3列で出力する

メルマガ発行内容

<Access クエリーをExcelシートへ10行x3列で出力する>

どうも、三流プログラマーのKen3です。 最近、質問もらうけど、 なかなか、解答できてない三流プログラマーのKen3です。 ※私のレベルで手に余る高度な質問が多くて。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba130.lzh にdb130.mdb(Access2000版)が保存されています。 ※クエリーやプログラムをいじって、遊んでみてください。

/* * 1. 今回のキッカケ */

郵便番号の集計システムを題材にして最近メルマガ書いてます。 [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 前回、 データを集計するクエリーまで、なんとかやりました。 パターン1 Q_YUBIN_7 郵便番号7桁(−付で8桁)、カウント10以上 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 郵便番号 郵便番号のカウント 桁数 220-0021 14 8 --- 条件は >=10(10以上) で =8(桁数は8桁) ↑設定・実行結果イメージ パターン2 Q_YUBIN_ETC 郵便番号7桁以外(−付で8桁以外)、カウント10以上 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 郵便番号 郵便番号のカウント 桁数 232 11 3 --- 条件は >=10(10以上) で <>8(桁数はNot 8桁) ↑設定・実行結果イメージ パターン3 Q_YUBIN_1to9 カウント数が10以下(1〜9)郵便番号が何桁であろうが ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 郵便番号 郵便番号のカウント 桁数 194-0012 1 8 228 1 3 700-0941 1 8 --- 条件は <10 (10以下) で (桁数の条件は無し) ↑設定・実行結果イメージ 今回は、このクエリーを元に、データを出力してみたいと思います。

/* * 2.方針を考える */

Q_YUBIN_7 : 郵便番号7桁(−付で8桁)、カウント10以上 Q_YUBIN_ETC : 郵便番号7桁以外(−付で8桁以外)、カウント10以上 Q_YUBIN_1to9 : カウント数が10以下(1〜9)郵便番号が何桁であろうが と3つのクエリーが存在します。 ここから、2つのシートを作るんだけど、さて、どうしましょう・・・ シートだけ作るなら、 ^^^^^^^^^^^^^^^^^^^^ 昔の自分のメルマガサンプルを見てみると、 <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へ出力してみたいと思います。

/* * 3.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  '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  'カウンタも忘れずに+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 そうですよ(開き直りか?) ↑エクセルへのクエリー結果出力イメージ

/* * 4.パズルは得意ですか?n列*n行の出力を考える */

さてと、n行になったら、となりの列を作成してみますか。 (作成って言うのか?たんにセット位置を移動というのか?) いきなり考えるのは難しいので、手で表を自分で作ってみます。 データは A列 B列 郵便番号 件数 107-0052 27 112-0002 27 113-0033 28  ・  ・  ・ なんて感じを、10行、3列にしてみると ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ (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) 10行いったら次の列 3列貯まったら空白1行空けて頭に戻る(次ページ分) そんなセット方法を考えてみる時、 まずは、 10単位でデータを処理するので、 11個目のデータは2行目D列(4)にセットされる。 ここをポイントにして、 次のレコードを読む 行カウンタ=行カウンタ+1 データカウンタ=データカウンタ+1 したあと、 カウンタが11だったら(11になったら) 列を+3する(A列の1からD列の4になる) 行を−10する。  データカウンタを1に戻す なんて、処理を入れると、10レコード単位で次の行に進めそうです。 進めるけどさぁ、 3列進んだら、空白1行空けて頭に戻る(次ページ分) は、どうするの? そっか、列もカウントしないといけないのか・・・ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ カウンタが11だったら(11になったら) 列を+3する(A列の1からD列の4になる) 列が9(3列)を越えたかチェックする  越えていれば:列をカウンタを1にして見出しを表示、行を増やす 越えていなければ:行を−10する。  データカウンタを1に戻す と、行が越えたかをチェックして、データをセットしてみます。 ↑データセットのイメージ プログラムを書くと、少し複雑だけど、 (まだまだ、改良の余地アリダケド) nRCNT = nRCNT + 1 '処理レコード数を増やす If nRCNT > 10 Then '処理したレコードが10を越えた(次の列) nXLINE = nXLINE + 3 '次の列へカウンタを移動 If nXLINE > 9 Then '列が越えた? nXLINE = 1 '1列目(A列)に戻す nYLINE = nYLINE + 2 '空白行にしたいのでセット位置を+2する Else nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする End If '見出しの表示 objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号" objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数" nYLINE = nYLINE + 1 '見出し表示分行数が増えます nRCNT = 1 '見出し表示後は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 '1行目だよ
    nXLINE = 1 '1列目(A列)だよ
    
    '見出しをセットする
    objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
    objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
    nYLINE = nYLINE + 1 '見出し分行数が増えます
    nRCNT = 1  '見出し表示後は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列目(A列)に戻す
                nYLINE = nYLINE + 2  '空白行にしたいのでセット位置を+2する
            Else
                nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする
            End If
            
            '見出しの表示
            objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
            objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
            nYLINE = nYLINE + 1 '見出し表示分行数が増えます
            nRCNT = 1  '見出し表示後は1レコード目だよ
        Else  '
            nYLINE = nYLINE + 1  '次の行へセット位置を移動
        End If
    Wend
    '通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き

    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

End Sub
-【けんぞう!】--------------------------------------------------------- 月500円、タバコなら2箱、120円缶コーヒーなら4缶分の謝礼をGetするなら http://www.ken3.org/etc/500yen/ ←無料アンケート系の広告です。 『チッ、がんばって回答して月500円かよ』(お馬鹿なプログラマー:30歳) ------------------------------------------------------------------------ 

/* * 5.終わりの挨拶 */

今回は、 クエリーをExcelのシートにセットする処理で、 10行3列でデータをセットしてみました。 なんか、あまりスマートじゃなかったけど、 こんな方法もあるってことで。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba130.lzh にdb130.mdb(Access2000版)が保存されています。 ※クエリーをいじって、遊んでみてください。 何かの参考となれば幸いです。 Excel/Access大好き、三流プログラマーKen3でした。


ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか?少々心配しつつ、、、

種類別のリンク や 広告など

気になったジャンル↓を選択してください。

人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記3つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係 関数、その他]・・・その他Excel関係です

Access関係:
[Access UserForm/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です

その他:VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます

開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う]

仕様書(設計書?) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力]

※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。
※※読んで、気分を悪くされたらスミマセン。

Blogとリンク:[三流君の作業日記]/ [VBAやASPのサンプルコード]/ 広告-[通販人気商品の足跡]



[三流君(TOP ken3.org へ戻る)] / [VBA系TOPへ] / [VBA系バックナンバー目次へ移動]