[No.135 Access テーブル作成クエリーを使用してみた]
[No.136 Access テーブル追加クエリーを使用してみた]
[No.137 Access クエリーを連続で実行させる]
[No.138 AccessからExcel出力、色・列幅・行の高さを調整する]
[No.139 AccessからExcel出力、複数クエリーを1シートへ]
www.ken3.org(サイト内)から Google を利用して、

三流君 VBAで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー] [VBA系 TOP] [三流君 TOP]



No.135 2003/09/26
Access テーブル作成クエリーを使用してみた
[ページTOPへ戻る]

<Access テーブル作成クエリーを使用してみた>

こんにちは、三流プログラマーのKen3です。 今回は、 テーブル作成クエリーを使用して、 既存のデータからテーブルを作成してみたいと思います。

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

No.133 仕様変更が来たら?落胆しないで前向きに? http://www.ken3.org/backno/backno_vba27.html#133 で、 集計方法を考えました。※良い悪い、は、置いといて(笑) 今回は、データ作りで、テーブル作成クエリーを使用してみたいと思います。

/* * 2.処理の仕様 */

処理の流れ、仕様は下記のような感じです。 MOTO_DATA テーブルにExcelからデータがインポートされます ※今回は、この時点からスタートします。 郵便番号 氏名 住所 電話番号 001-0854 鉢呂 北海道札幌市 061-3772 佐々 北海道石狩郡 101-0051 小林 東京都千代田 101-0054 杉本 東京都千代田 102-01 1940001 194 228-02 22802 上記データから3つのテーブルを作成します ア.YUBIN_DATA5 テーブルの作成 郵便番号フィールドを −を取り除き、5桁にしたデータを作成します。(上5桁を取り出す) 例)001-0854 --> 00108 , 102-01 --> 10201 郵便番号 00108 06137 10100 10100 と、−を取り除き、上5桁のテーブルを作成する  ※2・3桁のデータは、次のYUBIN_DATA3,YUBIN_DATA2に作成する イ.YUBIN_DATA3 テーブルの作成 3桁の郵便番号データのテーブルを作成する。 数のフィールドには固定で1をセットする YUBIN_DATA3 郵便番号 数 001 1 061 1 101 1 ※数のフィールドを作成データは1を固定でセット ウ.YUBIN_DATA2 同様に2桁の郵便番号データのテーブルを作成する。 数のフィールドには固定で1をセットする YUBIN_DATA2 郵便番号 数 01 1 02 1 44 1 ※数のフィールドを作成データは1を固定でセット

/* * 3.テーブル作成クエリーを使用する */

テーブル作成クエリーって?な人も居ると思います。 カッコつけて書いてますが、たいしたこと無くて、 普通にクエリーで表示した項目・値を使用して、 新しいテーブルの作成/既存のテーブルの書き換え を行うクエリーです。 簡単な作り方は(私の手順は) まず、表示する普通のクエリーを作成します。 YUBIN_DATA3 テーブルの作成 3桁の郵便番号データのテーブルを作成する。 数のフィールドには固定で1をセットする YUBIN_DATA3 郵便番号 数 001 1 061 1 101 1 ※数のフィールドを作成データは1を固定でセット イのYUBIN_DATA3 テーブルの作成時は、まず、 MOTO_DATA テーブルから、3桁のデータを表示するクエリーを作ります。 郵便番号と文字数をLen関数で計算したフィールドを取り、 計算した文字数が3と条件を付けたクエリーをまず作成します。 ※文字数フィールドの表示□チェックをしないのがポイントです。 ↑3桁の郵便番号を取り出したクエリー ここに、固定で1を表示したいので、 演算フィールドで 数:1 と固定値を書き込みます。 ↑演算フィールドで1を固定表示 これで、下記のようなデータを表示するクエリーが作成されました。 郵便番号 数 228 1 232 1 232 1 ここからが、本番です。 この表示したクエリーをテーブル作成クエリーに変更します。 変更手順は、これも簡単で、 メニューからクエリ・テーブル作成を選択します ↑メニューからクエリ・テーブル作成を選択 すると、 作成したいテーブル名を入れろと出てくるので、 YUBIN_DATA3と作成したいテーブル名を入力しOKを押します。 ↑テーブル名の入力 こんな感じで、出来てしまうんですね。 実行すると、確認メッセージが表示され、OKを押すとテーブルが作成されます。 ↑作成確認メッセージ 2桁のパターンは、Len(郵便番号)の条件が違うだけなので、 練習を兼ねて、作ってみてください。

/* * 4.演算フィールドで−を取り除く */

次は、少し面倒な、7桁の郵便番号から−を取って、 頭5桁の(上から5桁の)データテーブルを作成します。 操作したいデータ、そのままのデータを判断しやすいように、 まず紙に 実データ(想像データでも可能)元データ と 変換後のデータ のパターンを書きます(変換パターンを洗い出します) 元 変換後 001-0854 --> 00108 3+4桁の通常データ、−を取り、5桁にする 102-01 ----> 10201 3+2桁の過去データ、−を取り除く 0014567 ---> 00145 −無しの7桁データ、そのまま5桁取る 12398 -----> 12398 −無しの5桁データ、なにもしない 123 -------> 123 3桁のデータ、何もしない、※データも追加しない 001-0854 と 102-01 の時の判断は、4文字目が−か判断して、 頭から(左から)3文字+5文字目から2文字を抜き出し+すれば作れそうです。 4文字目が−じゃない時のデータは、 左から5文字をそのまま取れば作れそうです。 便利なIIf関数を使って、-を判断して、文字列を作成してみます。 IIf(Mid([郵便番号],4,1) = "-", -ありの処理, -なしの処理) と作れます。 -有りは、 Left([郵便番号],3) & Mid([郵便番号],5,2) -無しは、 Left([郵便番号],5) と、関数の組み合わせで作れそうです。 変換後郵便番号:IIf(Mid([郵便番号],4,1) = "-", Left([郵便番号],3) & Mid([郵便番号],5,2), Left([郵便番号],5)) と少々長いですが、演算フィールドで作成できます。 ↑長い演算フィールド、クエリーの作成イメージ おっと、これだと、228や194など、3桁の郵便番号も表示されてますね。 Len(郵便番号) が >4 と条件を入れないとね その後、テーブル作成のクエリーに変更して、 (メニューからクエリ・テーブル作成を選択します) テーブルを作成するクエリーが完成します。 誤算なのは、 郵便番号:IIf(Mid([郵便番号],4,1) = "-", Left([郵便番号],3) & Mid([郵便番号],5,2), Left([郵便番号],5)) とすると、循環参照のエラーが発生するので、 変換後郵便番号としているため、 仕様書通りのフィールド名でテーブルを作成できませんでした。 ↑循環参照のエラー発生イメージ -【けんぞう!】--------------------------------------------------------- ASPが利用可能なレンタルサーバーをお探しのアナタ、 http://www.ken3.org/asp/server.html ← けんぞうも使っているサーバーの紹介 『おっIISでbasp21でメール送信、mdbも使えるよ』(三流PG:31歳) ------------------------------------------------------------------------

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

今回は、 テーブル作成クエリーをと使用して、 クエリーからテーブルを作成してみました。 ポイントは、 ^^^^^^^^^^^^ 普通に表示用のクエリーを作成する。 クエリーのモードをテーブル作成に変更、作成するテーブル名を入れる。 そんな感じの流れで作成可能です。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba135.lzh にdb135.mdb(Access2000版)が保存されています。 ※クエリーやデータをいじって、遊んでみてください。 う〜ん、まだまだだなぁ・・・ 何かの参考となれば幸いです。 Excel/Access大好き、三流プログラマーKen3でした。

No.136 2003/09/28
Access テーブル追加クエリーを使用してみた
[ページTOPへ戻る]

<Access テーブル追加クエリーを使用してみた>

こんにちは、三流プログラマーのKen3です。 前回、 テーブル作成クエリーを使用して、 既存のデータからテーブルを作成してみました。 今回は、クエリーの検索結果を別テーブルへ追加する、 追加クエリーを使用してみたいと思います。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba136.lzh にdb135.mdb(Access2000版)が保存されています。 ※クエリーやデータをいじって、遊んでみてください。

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

No.135 Access テーブル作成クエリーを使用してみた http://www.ken3.org/backno/backno_vba28.html#135 で、 郵便番号別のテーブルを作成しました。 今回は、集計を行い、ある条件(10以下のデータ) を別のテーブルのデータに追加してみたいと思います。

/* * 2.処理の仕様 */

処理の流れ、仕様は下記のような感じです。 作成方法・方針の詳細は、 No.133 仕様変更が来たら?落胆しないで前向きに? http://www.ken3.org/backno/backno_vba27.html#133 上記を参照してください。 YUBIN_DATA5テーブルに対して、集計をかけます。 変換後郵便番号 70009 19400 22000 22000 ここから、 変換後郵便番号 変換後郵便番号のカウント 00108 27 06137 27 10100 5 10106 4 と、集計します。 ここで、カウント数によって2つの分かれ道、 10以上は、そのままExcelへデータセットに使います。 10回以下は、頭3桁の番号とカウント数を、YUBIN_DATA3テーブルへ追加します。 集計結果の、 10100 5 10106 4 を YUBIN_DATA3 に追加します ~~~~~~~~~~~ 郵便番号 数 001 1 (※1もともとセットされているデータ) 061 1 ( 〃 ) 101 1 ( 〃 ) 101 5 (YUBIN_DATA5の集計クエリーから10100集計5のデータ) 101 4 (YUBIN_DATA5の集計クエリーから10106集計4のデータ) ※郵便番号101数5 と 郵便番号101数4のデータが追加される なんて処理を、追加クエリーを使用して、作成してみます。

/* * 3.追加クエリーの作成方法 */

まぁ、追加クエリーなんて、カッコよく言っているけど、 手順としては、まず、追加するデータをセレクト・選択しないとね。 (選択された、ある条件のデーターを追加、そんなパターンなので) 普通に集計クエリーを作成します ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ YUBIN_DATA5テーブルに対して、 変換後郵便番号をグループ化してカウントします。 変換後郵便番号 変換後郵便番号のカウント 10800 2 11200 19 11300 13 ↑グループ化して、カウントしたクエリー 追加したいデータは、10以下のデータなので、条件<10を追加する。 それと、3桁のデータにして追加したいので、 YUBIN3桁:Left([変換後郵便番号])と式を追加して1つフィールドを作成します。 ※ポイントは、集計項目でLeftなど計算しているところを演算にします ↑グループ化して、カウント、条件10以下、左から3桁の項目(演算)作成 変換後郵便番号 変換後郵便番号のカウント YUBIN3桁 10500 1 105 10700 5 107 10755 9 107 10800 2 108 こんな感じで表示が出来たら、 このデータを YUBIN_DATA3テーブルに追加します ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ まず、クエリーの種類を通常の選択から、追加に変更します。 メニューのクエリーから追加を選択します。 ↑メニューからクエリーの追加を選択する すると、どのテーブルに追加するのか? って感じで、聞いてくるので(ダイアログが表示されるので) カレントデータベースのYUBIN_DATA3を選択します。 ↑追加先テーブルを選択したイメージ 次に、追加する項目を選択します。 ※フィールドを対応付けます。 変換後郵便番号 変換後郵便番号のカウント YUBIN3桁 10500 1 105 10700 5 107 を DATA_YUBIN3テーブル の 郵便番号フィールドにはYUBIN3桁, 数フィールドには変換後郵便番号のカウント を追加するために、 レコードの追加の項目で、追加先のフィールドを選択します。 ↑追加先フィールドを選択したイメージ これで、実行すると、集計して10以下のデータを追加することができます。

/* * 4.カウントから集計へ */

同様に、YUBIN_DATA3を集計して、10以下のデータをYUBIN_DATA2へ追加します。 ポイントは、 ^^^^^^^^^^^^ いままで、郵便番号でグループ化、郵便番号のカウント(数を数える) で、集計していたのですが、 YUBIN_DATA3 テーブルの構造は(作りは) ~~~~~~~~~~~ 郵便番号 数 001 1 (※1もともとセットされているデータ) 061 1 ( 〃 ) 101 1 ( 〃 ) 101 5 (YUBIN_DATA5の集計クエリーから10100集計5のデータ) 101 4 (YUBIN_DATA5の集計クエリーから10106集計4のデータ) ※郵便番号101数5 と 郵便番号101数4のデータが追加されている なので、 郵便番号はグループ化、フィールド[数]は合計としてグループ化します。 (※101は、1+5+4で10と合計を計算させる) ↑合計を計算するクエリー ~~~~~~~~~~~~~~~~~~~~~~~~ あとは、同様に、<10以下、頭2桁の項目を作成して、 YUBIN2_DATAに追加します。 (YUBIN2桁: Left([郵便番号],2)と演算フィールドを作成) ↑追加クエリーにして、YUBIN_DATA2の項目へ10以下のデータを追加 -【けんぞう!】--------------------------------------------------------- 転職関係、在宅プログラマー、SOHOの広告まとめました http://www.ken3.org/etc/500yen/zaitaku.html いろいろとあるので転機の人はぜひ 登録料無料、匿名で探せるので在宅でアルバイト、副業の人も見てね ------------------------------------------------------------------------ 

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

今回は、 追加クエリーを使用して、 他のテーブルにデータを追加してみました。 ポイントは、 ^^^^^^^^^^^^ 普通に表示用のクエリーを作成する。 クエリーのモードを追加に変更、追加するテーブル名とフィールドを選択。 そんな感じの流れで作成可能です。 あとは、このテーブルから、ExcelへデータをセットすればOKですね。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba136.lzh にdb136.mdb(Access2000版)が保存されています。 ※クエリーやデータをいじって、遊んでみてください。 う〜ん、まだまだだなぁ・・・ 何かの参考となれば幸いです。 Excel/Access大好き、三流プログラマーKen3でした。

No.137 2003/09/28
Access クエリーを連続で実行させる
[ページTOPへ戻る]

<Access クエリーを連続で実行させる>

こんにちは、三流プログラマーのKen3です。 前回、までで、やっとテーブル作成・データ作成ができました。 今回は、その作成したクエリーを連続で実行させてみたいと思います。

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

No.135 Access テーブル作成クエリーを使用してみた http://www.ken3.org/backno/backno_vba28.html#135 で、 郵便番号別のテーブルを作成しました。 No.136 Access テーブル追加クエリーを使用してみた http://www.ken3.org/backno/backno_vba28.html#136 で、 集計数が10以下のデータを別テーブルへ追加する、 追加クエリーを作成しました。 今回は、作成したクエリーを連続で実行してみます。 ※前回までは、作業者が手でクエリーをダブルクリックなどで実行してたけど、  まとめて実行してみたいと思います。

/* * 2.マクロで機能を実現してみる */

ある決まった処理をまとめて行う。 そんな時便利なのがAccessにもあるマクロです。 (※マクロ=VBAと思いがちですが、ここでは、   Accessのマクロ機能で攻めてみます) 新規でマクロを作成し、 アクションでクエリを開くを選択します。 ↑マクロのアクション選択画面 次に、アクションのパラメータを入れます。 開きたいクエリー名をセットします。 ↑クエリー名称の入力 ここまでで、1つのクエリーを開けたので、 順番に、 クエリを開く MAKE_DATA5 クエリを開く MAKE_DATA3 クエリを開く MAKE_DATA2 クエリを開く DATA5から10以下のデータをDATA3へ追加 クエリを開く DATA3から10以下のデータをDATA2へ追加 と、作成します。 開く順番を間違えなければOKでしょう。 実行すると、確認メッセージが表示されるが、なんとか動きました。 ・テーブル作成クエリを実行すると新しくテーブルが作成されます や ・XX件のデータを追加します なんてメッセージ、表示をやめたいですよね。 そんな時は、マクロのアクションで、 メッセージの設定をいいえにすると、メッセージが出なくなります。 ↑アクションにメッセージの表示を追加する

/* * 3.マクロをモジュールに変換して、コードを見てみる */

マクロが出来たので、今度は、そのマクロをVBAのモジュールに変換してみます。 ※まぁ、変換しないでもいいんだけど、ネタ的に使いたかったので(笑) 変換したいマクロを選択して、 右ボタンを押して、ショートカットメニューを表示させます。 その中から、名前を付けて保存を選択します。 貼り付ける形式をモジュールにします。 ~~~~~~~~~~~~~~~~~~~~~~~~~~ ↑マクロを選択後、右ボタン・形式をモジュールにする 下記のような感じで、モジュールに変換できます。
Function マクロ1()
On Error GoTo マクロ1_Err

    DoCmd.SetWarnings False
    ' MAKE_DATA5
    DoCmd.OpenQuery "MAKE_DATA5", acViewNormal, acEdit
    ' MAKE_DATA3
    DoCmd.OpenQuery "MAKE_DATA3", acViewNormal, acEdit
    ' MAKE_DATA2
    DoCmd.OpenQuery "MAKE_DATA2", acViewNormal, acEdit
    ' DATA5から10以下のデータをDATA3へ追加
    DoCmd.OpenQuery "YUBIN_DATA5から10以下を追加", acViewNormal, acEdit
    ' DATA3から10以下のデータをDATA2へ追加
    DoCmd.OpenQuery "YUBIN_DATA3から10以下を追加", acViewNormal, acEdit

マクロ1_Exit:
    Exit Function

マクロ1_Err:
    MsgBox Error$
    Resume マクロ1_Exit

End Function
確認メッセージを消す、 メッセージの設定アクションが、 DoCmd.SetWarnings False に変換されています。 その後、カーソルを合わせてF1を押し、.SetWarnings Falseを調べるといいですよ。 こんな感じで、マクロのアクションに対応したモジュールを探ることが出来ます。 ヘルプをいきなり見るよりも、慣れないうちはこんな方法もよいのでは? ※アクションがDoCmd.XXX系になるみたいですね。 -【けんぞう!】--------------------------------------------------------- 月500円、タバコなら2箱、120円缶コーヒーなら4缶分の謝礼をGetするなら http://www.ken3.org/etc/500yen/ ←無料アンケート系の広告です。 『チッ、がんばって回答して月500円かよ』(お馬鹿なプログラマー:31歳) ※家族4人分の登録でも月2000円、、、なんとかプロバイダー代くらいかなぁ。 ------------------------------------------------------------------------

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

今回は、 作成したクエリーを連続実行させるために、 マクロを作りました。 さらにおまけで、マクロからモジュールを作成して、 命令を探ってみました。 残るは、Excelへデータをセットですね。 う〜ん、まだまだだなぁ・・・ 何かの参考となれば幸いです。 Excel/Access大好き、三流プログラマーKen3でした。

No.138 2003/09/29
AccessからExcel出力、色・列幅・行の高さを調整する
[ページTOPへ戻る]

<AccessからExcel出力、色・列幅・行の高さを調整する>

こんにちは、三流プログラマーのKen3です。 郵便番号データの集計処理もいよいよ終盤戦です。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba138.lzh にdb138.mdb(Access2000版)が保存されています。 ※クエリーやデータをいじって、遊んでみてください。 Access から Excel 連携 http://www.ken3.org/cgi-bin/group/vba_access_excel.asp も参考にしてください。

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

前回、までで、なんとか、出力用のデータをそろえられました。 ※ここまでに、かなり時間がかかりましたが。 今回は、 AccessからExcelへ出力時に、 セルに色を付けたり、列幅・行の高さを設定してみたいと思います。

/* * 2.Excelのマクロ記録で機能を探る */

セルに色を付ける、 列幅・行の高さを設定 そんな感じで、Excelのオブジェクトを操作したいので、 探り方としては、Excelのマクロ自動記録の機能を使用して探ってみます。 [No.2 AccessからExcel出力] http://www.ken3.org/backno/backno_vba01.html#2 で、 ・ウィザードを使ってたサンプルを作れることを説明 ・マクロ記録でExcelの操作をVBAにする ・頭にオブジェクト変数を付けてAccessからExcelを操作 を書いているので、参考にしてみてください。 色の変更、列幅の変更、行の高さの変更 この操作をマクロ記録してみます。 ↑行った操作 記録で作られたマクロは、こんな感じです。
Sub Macro1()

    Range("A1:A3").Select
    With Selection.Interior
        .ColorIndex = 5
        .Pattern = xlSolid
    End With
    Range("B1:B3").Select
    With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
    Columns("A:A").Select
    Selection.ColumnWidth = 8
    Columns("B:B").Select
    Selection.ColumnWidth = 6
    Rows("2:4").Select
    Selection.RowHeight = 16

End Sub
セルの色は、 ^^^^^^^^^^^^ .Interior.ColorIndex = 5 .Interior.ColorIndex = 6 など、で設定可能なので、事前に色の番号をマクロ記録で調べてもいいし、 RGBなどで、作ってもOKかなぁ。 列幅は、 ^^^^^^^^ Columns("A:A").Select で列選択、 Selection.ColumnWidth = 8 で、幅を設定。 ※選択処理しないで、直接設定も可能です。 行の高さは、 ^^^^^^^^^^ Rows("2:4").Select で、行選択、 Selection.RowHeight = 16 で、行の高さを設定 あとの詳細は、ヘルプを見る。 そんな感じで探れそうです。

/* * 3.Excelの出力処理に組み込む */

[No.131 Access クエリーをExcelシートへ罫線を付けて出力する] http://www.ken3.org/backno/backno_vba27.html#131 罫線付で、データをExcelへ出力してみました。 この処理に、 今回調べた、色を付ける処理、列幅、行の高さ、3つの機能を追加してみます。 まず列幅から、処理していきたいと思います。 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ (1) (2) (3) (4) (5) (6) (7) (8) (9) n行目 A列 B列 C列 D列 E列 F列 G列 H列 I列 001行 郵便番号 件数 空白 郵便番号 件数 空白 郵便番号 件数 空白 002行 107-52 27 160-23 27 193-33 27 003行 112-02 27 列の幅は、A列は10、B列は15など幅は縦に設定するので シートを作成したときに設定してみます。 郵便番号と件数の列を8.5、空白列を1.8に設定します。 For文で、3列単位で回してみました。 '列幅は、縦なので、ここ、頭で定義する For nXLINE = 1 To 9 Step 3 objEXCEL.Columns(nXLINE).ColumnWidth = 8.5 objEXCEL.Columns(nXLINE + 1).ColumnWidth = 8.5 objEXCEL.Columns(nXLINE + 2).ColumnWidth = 1.8 Next nXLINE こんな感じで、3列単位に、列幅を設定しました。 次は、行の高さです ^^^^^^^^^^^^^^^^^^ 行の高さは、見出しの文字列、罫線を引いた後にセットしてみたと思います。 見出しの高さを25、データの高さを16に設定します。 '行の高さを調整する objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '10行分の範囲文字列 objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ nYLINEが行カウンタなので、 Rows(nYLINE)で見出しの位置指定、 .RowHeight = 25で行の高さをセットしました。 nYLINEが1だとするとRows(1).RowHeight = 25としてます。 ~~~~~~~~~~~~~~~~~~~~ 次がデータ行です。 Rows("2:4").Select で、2〜4行選択、だったので、 :コロンで区切った文字列を作成して、指定します。 見出しの次の行から指定なので、 strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '10行分の範囲文字列 と 10行分の範囲 2:11を作成して、 Rows(strWORK)で範囲を指定、 .RowHeight = 16で高さのプロパティを16になする。 最後が、セルの色付けです。 ^^^^^^^^^^^^^^^^^^^^^^^^^^ セットのタイミングは簡単で、 セルにデータをセットした後に、背景色のプロパティを変更します。 'データをセットする(Accessから転記) objEXCEL.Cells(nYLINE, nXLINE) = rs("変換後郵便番号").Value objEXCEL.Cells(nYLINE, nXLINE + 1) = rs("変換後郵便番号のカウント").Value 'セルの色を変える objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = 33 'スカイブルー objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = 33 セルにマクロ記録で調べたカラーインデックスの33をセットしてます。 ↑実行結果です、なんとかここまでできました。 部分的に考えると、なんとかなりそうですね。 組み込んだ、長いセットのソースは、下記のような感じです。
Private Sub btnMakeExcel_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 'レコードカウンタ
    Dim strWORK  As String  'ワーク変数

    'Excelを起動する、オブジェクトの作成
    Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
    objEXCEL.Visible = True  'Excelを見えるようにする
    
    '新規のブックを追加する
    objEXCEL.Workbooks.Add   'Excelのブックを作成

    'Excelのシートを追加、シート名を変更する
    objEXCEL.Sheets.Add  'シートを追加する
    objEXCEL.ActiveSheet.Name = "DATA"  'シート名をDATAにする
    
    '列幅は、縦なので、ここ、頭で定義する
    For nXLINE = 1 To 9 Step 3
        objEXCEL.Columns(nXLINE).ColumnWidth = 8.5
        objEXCEL.Columns(nXLINE + 1).ColumnWidth = 8.5
        objEXCEL.Columns(nXLINE + 2).ColumnWidth = 1.8
    Next nXLINE

    'レコードセットを開く(Q_YUBIN_5)
    rs.Open "Q_YUBIN5", CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic

    'カウンタの初期化 スタート位置のセット
    nYLINE = 1 '1行目だよ
    nXLINE = 1 '1列目(A列)だよ
    
    '見出しをセットする
    objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
    objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
    '罫線を引く(見出しの位置から+10行分)
    Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                    objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
    '行の高さを調整する
    objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
    strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '10行分の範囲文字列
    objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ

    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
        'セルの色を変える
        objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = 33 'スカイブルー
        objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = 33
        '次を読む 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) = "件数"
            '罫線を引く(見出しの位置から+10行分)
            Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                      objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
            '行の高さを調整する
            objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
            strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '範囲文字列を作成
            objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ
            
            nYLINE = nYLINE + 1 '見出し表示分行数が増えます
            nRCNT = 1  '見出し表示後は1レコード目だよ
        Else  '
            nYLINE = nYLINE + 1  '次の行へセット位置を移動
        End If
    Wend
    '通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き

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

End Sub
'Rangeのエリアを受け取り、罫線を引く
Private Sub make_Border(objXY As Object)

    '罫線用のExcel定数(参照設定している場合は、必要無し)
    Const xlEdgeLeft = &H7
    Const xlEdgeRight = &HA
    Const xlEdgeTop = &H8
    Const xlEdgeBottom = &H9
    Const xlInsideVertical = &HB
    Const xlInsideHorizontal = &HC

    Const xlContinuous = &H1
    Const xlThin = &H2
    Const xlAutomatic = &HFFFFEFF7

    Dim n As Integer

    '配列に代入する
    Dim styleBOX As Variant
    styleBOX = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop _
                  , xlEdgeBottom, xlInsideVertical, xlInsideHorizontal)

    For n = 0 To 5 '各ラインに対して、値をセットする
        With objXY.Borders(styleBOX(n))
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    Next n

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

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

今回は、 AccessからExcelへの出力で、 列幅の変更、行の高さの変更、セルの背景色の変更 をやりました。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba138.lzh にdb138.mdb(Access2000版)が保存されています。 ※クエリーやデータをいじって、遊んでみてください。 あとは、連続してデータをセットですね。 う〜ん、まだまだだなぁ・・・ 何かの参考となれば幸いです。 Excel/Access大好き、三流プログラマーKen3でした。

No.139 2003/09/29
AccessからExcel出力、複数クエリーを1シートへ
[ページTOPへ戻る]

<AccessからExcel出力、複数クエリーを1シートへ>

こんにちは、三流プログラマーのKen3です。 郵便番号データの集計処理もいよいよ終盤戦です。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba139.lzh にdb139.mdb(Access2000版)が保存されています。 ※クエリーやデータをいじって、遊んでみてください。 Access から Excel 連携 http://www.ken3.org/cgi-bin/group/vba_access_excel.asp も参考にしてください。

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

前回、までで、 ・出力用のデータをそろえる ・罫線、色、列幅、行の高さ・・などのセット方法 そんな感じの単体テストがやっと終わってます。 今回は、 AccessからExcelへ出力で、 複数のクエリーを1つのシートに出力してみます。

/* * 2.クエリーを4つ用意する */

集計の仕様は、こんな感じでした。 No.133 仕様変更が来たら?落胆しないで前向きに? http://www.ken3.org/backno/backno_vba27.html#133 で、 集計方法を考えました。※良い悪い、は、置いといて(笑) >1.郵便番号の上から5桁を番号別に集計して・・・ > >2.5桁で集計したものの中で10通以下(9〜1通)になったものを > 今度は上から3桁で集計する > >3.3桁で集計したものの中で10通以下(9〜1通)になったものを > 今度は上から2桁で集計する > >4.2桁で集計したものの中で10通以下(9〜1通)になったものを > △△△と言う名前で集計する MOTO_DATA テーブルに住所付の郵便番号データ から YUBIN_DATA5 上5桁に削ったデータ YUBIN_DATA3 3桁のデータとYUBIN_DATA5で10以下の番号 YUBIN_DATA2 2桁のデータとYUBIN_DATA3で10以下の番号 と、テーブルを3つ作成しました。 上記の3つのテーブルから4つのクエリーを作成します Q_YUBIN5 「5桁集計結果10件以上のみ」 ^^^^^^^^ YUBIN_DATA5を郵便番号でグループ集計して、 数が10以上のデータを表示します。 ~~~~~~~~~~~~ 番号 通数 10701 11 11200 19 11300 13 集計クエリーでフィールド名を番号、通数として作ってます。 番号: 変換後郵便番号 として、フィールド名を変更してます ↑作成したクエリービルダーの様子 Q_YUBIN3 「3桁集計結果10件以上のみ」 ^^^^^^^^ YUBIN_DATA3を郵便番号でグループ集計して、 数が10以上のデータを表示します。 ~~~~~~~~~~~~ 番号 通数 107 17 113 11 135 13 集計クエリーでフィールド名を番号、通数として作ってます。 ↑作成したクエリービルダーの様子 Q_YUBIN2 「2桁10件以上」 ^^^^^^^^ YUBIN_DATA2を郵便番号でグループ集計して、 数が10以上のデータを表示します。 ~~~~~~~~~~~~ 番号 通数 11 14 16 23 17 13 集計クエリーでフィールド名を番号、通数として作ってます。 ↑作成したクエリービルダーの様子 Q_YUBIN_ETC 「2桁10件以下」 ^^^^^^^^ YUBIN_DATA2を郵便番号でグループ集計して、 数が10以下(1〜9)のデータを表示します。 ~~~~~~~~~~~~~~~~~~~ 番号 通数 00 1 06 1 10 8 集計クエリーでフィールド名を番号、通数として作ってます。 ↑作成したクエリービルダーの様子 やっと、4つのクエリーが作成できました。

/* * 3.Excelの出力処理に組み込む */

[No.138 AccessからExcel出力、色・列幅・行の高さを調整する] http://www.ken3.org/backno/backno_vba28.html#138 色や列幅、高さを変える方法を上記で探りました、 この処理に、 今回作成した4つのクエリーを使い、データを追加してみます。 青(37) Q_YUBIN5 ----- 「5桁集計結果10件以上のみ」 水色(34) Q_YUBIN3 ----- 「3桁集計結果10件以上のみ」 黄色(36) Q_YUBIN2 ----- 「2桁10件以上」 緑(35) Q_YUBIN_ETC -- 「2桁10件以下」 の4色(カッコ内はカラー番号)で、出力してみたいと思います。 単純に、縦に並べてクエリーの出力を作成すると、 こんな感じになります。 ※長いだけのテク無しプログラムだね・・・ ↑作成結果 下記、長いだけのコピープログラム(笑)
Private Sub btnMakeExcel_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 'レコードカウンタ
    Dim strWORK  As String  'ワーク変数

    '----------------------------------
    'Excel 関係の準備
    '----------------------------------
    'Excelを起動する、オブジェクトの作成
    Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
    objEXCEL.Visible = True  'Excelを見えるようにする
    
    '新規のブックを追加する
    objEXCEL.Workbooks.Add   'Excelのブックを作成

    'Excelのシートを追加、シート名を変更する
    objEXCEL.Sheets.Add  'シートを追加する
    objEXCEL.ActiveSheet.Name = "DATA"  'シート名をDATAにする
    
    '列幅は、縦なので、ここ、頭で定義する
    For nXLINE = 1 To 9 Step 3
        objEXCEL.Columns(nXLINE).ColumnWidth = 8.5
        objEXCEL.Columns(nXLINE + 1).ColumnWidth = 8.5
        objEXCEL.Columns(nXLINE + 2).ColumnWidth = 1.8
    Next nXLINE

    '----------------------------------
    '見出しや変数の初期処理
    '----------------------------------
    'カウンタの初期化 スタート位置のセット
    nYLINE = 1 '1行目だよ
    nXLINE = 1 '1列目(A列)だよ
    
    '見出しをセットする
    objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
    objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
    '罫線を引く(見出しの位置から+10行分)
    Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                    objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
    '行の高さを調整する
    objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
    strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '10行分範囲文字列を作成
    objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ

    nYLINE = nYLINE + 1 '見出し分行数が増えます
    nRCNT = 1  '見出し表示後は1レコード目だよ
    
    '------------------------------------------------------------
    '青(37)   Q_YUBIN5  「5桁集計結果10件以上のみ」セット処理
    '------------------------------------------------------------
    'レコードセットを開く(Q_YUBIN5)
    rs.Open "Q_YUBIN5", CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic
    'レコードセットからExcelへデータをセットする
    'ループ処理
    While rs.EOF = False  'いつものEOFが偽の間
        'データをセットする(Accessから転記)
        objEXCEL.Cells(nYLINE, nXLINE) = rs("番号").Value
        objEXCEL.Cells(nYLINE, nXLINE + 1) = rs("通数").Value
        'セルの色を変える
        objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = 37 '青をセット
        objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = 37
        '次を読む 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) = "件数"
            '罫線を引く(見出しの位置から+10行分)
            Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                      objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
            '行の高さを調整する
            objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
            strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '範囲文字列を作成
            objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ
            
            nYLINE = nYLINE + 1 '見出し表示分行数が増えます
            nRCNT = 1  '見出し表示後は1レコード目だよ
        Else  '
            nYLINE = nYLINE + 1  '次の行へセット位置を移動
        End If
    Wend
    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

    '------------------------------------------------------------
    '水色(34) Q_YUBIN3 「3桁集計結果10件以上のみ」セット処理
    '------------------------------------------------------------
    'レコードセットを開く(Q_YUBIN3)
    rs.Open "Q_YUBIN3", CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic
    'レコードセットからExcelへデータをセットする
    'ループ処理
    While rs.EOF = False  'いつものEOFが偽の間
        'データをセットする(Accessから転記)
        objEXCEL.Cells(nYLINE, nXLINE) = rs("番号").Value
        objEXCEL.Cells(nYLINE, nXLINE + 1) = rs("通数").Value
        'セルの色を変える
        objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = 34 '水色をセット
        objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = 34
        '次を読む 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) = "件数"
            '罫線を引く(見出しの位置から+10行分)
            Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                      objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
            '行の高さを調整する
            objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
            strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '範囲文字列を作成
            objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ
            
            nYLINE = nYLINE + 1 '見出し表示分行数が増えます
            nRCNT = 1  '見出し表示後は1レコード目だよ
        Else  '
            nYLINE = nYLINE + 1  '次の行へセット位置を移動
        End If
    Wend
    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

    '------------------------------------------------------------
    '黄色(36) Q_YUBIN2 「2桁10件以上」セット処理
    '------------------------------------------------------------
    'レコードセットを開く(Q_YUBIN3)
    rs.Open "Q_YUBIN2", CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic
    'レコードセットからExcelへデータをセットする
    'ループ処理
    While rs.EOF = False  'いつものEOFが偽の間
        'データをセットする(Accessから転記)
        objEXCEL.Cells(nYLINE, nXLINE) = rs("番号").Value
        objEXCEL.Cells(nYLINE, nXLINE + 1) = rs("通数").Value
        'セルの色を変える
        objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = 36 '黄色をセット
        objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = 36
        '次を読む 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) = "件数"
            '罫線を引く(見出しの位置から+10行分)
            Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                      objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
            '行の高さを調整する
            objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
            strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '範囲文字列を作成
            objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ
            
            nYLINE = nYLINE + 1 '見出し表示分行数が増えます
            nRCNT = 1  '見出し表示後は1レコード目だよ
        Else  '
            nYLINE = nYLINE + 1  '次の行へセット位置を移動
        End If
    Wend
    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

    '------------------------------------------------------------
    '緑(35)   Q_YUBIN_ETC 「2桁10件以下」セット処理
    '------------------------------------------------------------
    'レコードセットを開く(Q_YUBIN3)
    rs.Open "Q_YUBIN2", CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic
    'レコードセットからデータを集計する
    '最後のその他は、まとめるので
    Dim nCNT As Long
    nCNT = 0 '0を代入
    
    'ループ処理
    While rs.EOF = False  'いつものEOFが偽の間
        'カウントアップ
        nCNT = nCNT + rs("通数").Value 'タダ足しているだけです
        '次を読む And カウンタを移動する
        rs.MoveNext  '次のレコードに移動
    Wend
    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

    'データをセットする(Accessから転記)
    objEXCEL.Cells(nYLINE, nXLINE) = "△△"
    objEXCEL.Cells(nYLINE, nXLINE + 1) = nCNT
    'セルの色を変える
    objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = 35 '緑色をセット
    objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = 35

End Sub

/* * 4.配列を使ってまとめる */

コピープログラム(笑) なんて笑ってないで、修正しろよ。 ですよね、チョット前、 [作成時 Ctrl+C Ctrl+Vの前によく考えよう] http://www.ken3.org/vba/vba-copy-pg.html ↑で、 Ctrl+CとCtrl+Vでソースを安易にコピーしたプログラムはイケナイ チエちゃん好き、ミキちゃん好き、アキちゃん好き、マイちゃん好き と名前を出すときは?
Sub AAA()
   Msgbox "チエちゃん好き"
   Msgbox "ミキちゃん好き"
   Msgbox "アキちゃん好き"
   Msgbox "マイちゃん好き"
End Sub
じゃなくって、 ^^^^^^^^^^^^^^
Sub BBB()

    Dim strNAME As Variant
    Dim n As Integer
    '配列を代入
    strNAME = Array("チエ", "ミキ", "アキ", "マイ")
    'データを表示
    For n = 0 To 3
        MsgBox strNAME(n) & "ちゃん好きです"
    Next n

End Sub
と、 ループとArrayで配列を作成 知識のある人は作るかな。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ なんて感じで、偉そうに書いていたのに・・・ 話を戻して、よく見ると、 使用しているクエリーの名前と、カラー番号が違うだけなんですね。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ これを配列変数に入れて、ループで回してみます。 青(37) Q_YUBIN5 ----- 「5桁集計結果10件以上のみ」 水色(34) Q_YUBIN3 ----- 「3桁集計結果10件以上のみ」 黄色(36) Q_YUBIN2 ----- 「2桁10件以上」 Arrayで初期化してもいいけど、:(コロン)で1行に2命令書いてみます。 Dim strQNAME(3) As String 'クエリーの名前 Dim nQCOLOR(3) As Integer '色の番号 '配列の初期化 strQNAME(0) = "Q_YUBIN5": nQCOLOR(0) = 37 strQNAME(1) = "Q_YUBIN3": nQCOLOR(1) = 34 strQNAME(2) = "Q_YUBIN2": nQCOLOR(2) = 36 と、 配列変数に代入して、 For nQCNT = 0 To 2 '0〜2までループ ・   ・ Next のループで回し、 rs.Open strQNAME(nQCNT), CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic と、配列変数で指定した、nQCNT番目のクエリーを開き、 カラーセットの部分でも、 objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = nQCOLOR(nQCNT) nQCNT番目が指すカラー番号を代入してます。 こんな感じで、少し、短くなりました。 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Private Sub btnMAKE2_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 'レコードカウンタ
    Dim strWORK  As String  'ワーク変数

    '----------------------------------
    'Excel 関係の準備
    '----------------------------------
    'Excelを起動する、オブジェクトの作成
    Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
    objEXCEL.Visible = True  'Excelを見えるようにする
    
    '新規のブックを追加する
    objEXCEL.Workbooks.Add   'Excelのブックを作成

    'Excelのシートを追加、シート名を変更する
    objEXCEL.Sheets.Add  'シートを追加する
    objEXCEL.ActiveSheet.Name = "DATA"  'シート名をDATAにする
    
    '列幅は、縦なので、ここ、頭で定義する
    For nXLINE = 1 To 9 Step 3
        objEXCEL.Columns(nXLINE).ColumnWidth = 8.5
        objEXCEL.Columns(nXLINE + 1).ColumnWidth = 8.5
        objEXCEL.Columns(nXLINE + 2).ColumnWidth = 1.8
    Next nXLINE

    '----------------------------------
    '見出しや変数の初期処理
    '----------------------------------
    'カウンタの初期化 スタート位置のセット
    nYLINE = 1 '1行目だよ
    nXLINE = 1 '1列目(A列)だよ
    
    '見出しをセットする
    objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
    objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
    '罫線を引く(見出しの位置から+10行分)
    Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                    objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
    '行の高さを調整する
    objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
    strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '10行分範囲文字列を作成
    objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ

    nYLINE = nYLINE + 1 '見出し分行数が増えます
    nRCNT = 1  '見出し表示後は1レコード目だよ
    
    '------------------------------------------------------------
    '3つのクエリーをExcelへセットする
    '------------------------------------------------------------
    Dim nQCNT As Integer       'クエリーのカウンタ
    Dim strQNAME(3) As String  'クエリーの名前
    Dim nQCOLOR(3)  As Integer '色の番号
    
    '配列の初期化
    strQNAME(0) = "Q_YUBIN5": nQCOLOR(0) = 37
    strQNAME(1) = "Q_YUBIN3": nQCOLOR(1) = 34
    strQNAME(2) = "Q_YUBIN2": nQCOLOR(2) = 36
    
  For nQCNT = 0 To 2  '0〜2までループ
    'nQCNT番目のレコードセットを開く
    rs.Open strQNAME(nQCNT), CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic
    'レコードセットからExcelへデータをセットする
    'ループ処理
    While rs.EOF = False  'いつものEOFが偽の間
        'データをセットする(Accessから転記)
        objEXCEL.Cells(nYLINE, nXLINE) = rs("番号").Value
        objEXCEL.Cells(nYLINE, nXLINE + 1) = rs("通数").Value
        'セルの色を変える
        objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = nQCOLOR(nQCNT) '色をセット
        objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = nQCOLOR(nQCNT)
        '次を読む 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) = "件数"
            '罫線を引く(見出しの位置から+10行分)
            Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                      objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
            '行の高さを調整する
            objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
            strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '範囲文字列を作成
            objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ
            
            nYLINE = nYLINE + 1 '見出し表示分行数が増えます
            nRCNT = 1  '見出し表示後は1レコード目だよ
        Else  '
            nYLINE = nYLINE + 1  '次の行へセット位置を移動
        End If
    Wend
    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?
  Next nQCNT


    '------------------------------------------------------------
    '緑(35)   Q_YUBIN_ETC 「2桁10件以下」セット処理
    '------------------------------------------------------------
    'レコードセットを開く(Q_YUBIN3)
    rs.Open "Q_YUBIN2", CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic
    'レコードセットからデータを集計する
    '最後のその他は、まとめるので
    Dim nCNT As Long
    nCNT = 0 '0を代入
    
    'ループ処理
    While rs.EOF = False  'いつものEOFが偽の間
        'カウントアップ
        nCNT = nCNT + rs("通数").Value 'タダ足しているだけです
        '次を読む And カウンタを移動する
        rs.MoveNext  '次のレコードに移動
    Wend
    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

    'データをセットする(Accessから転記)
    objEXCEL.Cells(nYLINE, nXLINE) = "△△"
    objEXCEL.Cells(nYLINE, nXLINE + 1) = nCNT
    'セルの色を変える
    objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = 35 '緑色をセット
    objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = 35

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

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

今回は、 複数のクエリーを1つのシートに出力してみました。 ※クエリー単位で色を変えて。 プログラムの組み方も、コピーで適当に作らないで、 ループで作る・・なんて感じのことも少々。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba139.lzh にdb139.mdb(Access2000版)が保存されています。 ※クエリーやデータをいじって、遊んでみてください。 あとは、インポートファイル名の選択やテストですね。 何かの参考となれば幸いです。 Excel/Access大好き、三流プログラマーKen3でした。


検索して目的の情報を探す。

目的の情報を探すには、最近はググれとよく聞きます。なので、検索ボックスを付けました。
いろいろなキーワードを入れて、検索してみてください。

カスタム検索
三流君(site:www.ken3.org) 内を Googleを利用してキーワード する

ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか?少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。

質問や要望など メッセージを送る(三流君に連絡する)

質問や要望など連絡方法でお互い確認が取りやすく、便利なのが掲示板なのですが、私の対応のまずさから不定期で荒れてしまい、掲示板は現在封鎖中です。(反省しなきゃ)
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。
あなたのお名前(ニックネーム):さん
返信は?: 不用(HP更新を待つ) , E-mail→ アドレス:に返事をもらいたい



(感想や質問・要望 メッセージはHPで記事に載せることがあります。)

急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。

リンクや広告など

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

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

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

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

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

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

Blog:[三流君の作業日記]/ [サンプルコードのゴミ箱]/ 広告-[通販人気商品の足跡]



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