三流君 ＶＢＡで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー]
[VBA系 TOP]
[三流君 TOP]
＜Access テーブル作成クエリーを使用してみた＞
こんにちは、三流プログラマーのＫｅｎ３です。
今回は、
テーブル作成クエリーを使用して、
既存のデータからテーブルを作成してみたいと思います。
/*
* １. 今回のキッカケ
*/
No.133 仕様変更が来たら？落胆しないで前向きに？
http://www.ken3.org/backno/backno_vba27.html#133
で、
集計方法を考えました。※良い悪い、は、置いといて（笑）
今回は、データ作りで、テーブル作成クエリーを使用してみたいと思います。
/*
* ２．処理の仕様
*/
処理の流れ、仕様は下記のような感じです。
MOTO_DATA テーブルにExcelからデータがインポートされます
※今回は、この時点からスタートします。
郵便番号 氏名 住所 電話番号
001-0854 鉢呂 北海道札幌市
061-3772 佐々 北海道石狩郡
101-0051 小林 東京都千代田
101-0054 杉本 東京都千代田
102-01
1940001
194
228-02
22802
上記データから３つのテーブルを作成します
ア．YUBIN_DATA5 テーブルの作成
郵便番号フィールドを
−を取り除き、５桁にしたデータを作成します。(上５桁を取り出す)
例)001-0854 --＞ 00108 , 102-01 --＞ 10201
郵便番号
00108
06137
10100
10100
と、−を取り除き、上５桁のテーブルを作成する
※２・３桁のデータは、次のYUBIN_DATA3,YUBIN_DATA2に作成する
イ．YUBIN_DATA3 テーブルの作成
３桁の郵便番号データのテーブルを作成する。
数のフィールドには固定で１をセットする
YUBIN_DATA3
郵便番号 数
001 1
061 1
101 1
※数のフィールドを作成データは１を固定でセット
ウ．YUBIN_DATA2
同様に２桁の郵便番号データのテーブルを作成する。
数のフィールドには固定で１をセットする
YUBIN_DATA2
郵便番号 数
01 1
02 1
44 1
※数のフィールドを作成データは１を固定でセット
/*
* ３．テーブル作成クエリーを使用する
*/
テーブル作成クエリーって？な人も居ると思います。
カッコつけて書いてますが、たいしたこと無くて、
普通にクエリーで表示した項目・値を使用して、
新しいテーブルの作成/既存のテーブルの書き換え
を行うクエリーです。
簡単な作り方は（私の手順は）
まず、表示する普通のクエリーを作成します。
YUBIN_DATA3 テーブルの作成
３桁の郵便番号データのテーブルを作成する。
数のフィールドには固定で１をセットする
YUBIN_DATA3
郵便番号 数
001 1
061 1
101 1
※数のフィールドを作成データは１を固定でセット
イのYUBIN_DATA3 テーブルの作成時は、まず、
MOTO_DATA テーブルから、３桁のデータを表示するクエリーを作ります。
郵便番号と文字数をLen関数で計算したフィールドを取り、
計算した文字数が３と条件を付けたクエリーをまず作成します。
※文字数フィールドの表示□チェックをしないのがポイントです。
↑３桁の郵便番号を取り出したクエリー
ここに、固定で１を表示したいので、
演算フィールドで 数:1 と固定値を書き込みます。
↑演算フィールドで１を固定表示
これで、下記のようなデータを表示するクエリーが作成されました。
郵便番号 数
228 1
232 1
232 1
ここからが、本番です。
この表示したクエリーをテーブル作成クエリーに変更します。
変更手順は、これも簡単で、
メニューからクエリ・テーブル作成を選択します
↑メニューからクエリ・テーブル作成を選択
すると、
作成したいテーブル名を入れろと出てくるので、
YUBIN_DATA3と作成したいテーブル名を入力しＯＫを押します。
↑テーブル名の入力
こんな感じで、出来てしまうんですね。
実行すると、確認メッセージが表示され、OKを押すとテーブルが作成されます。
↑作成確認メッセージ
２桁のパターンは、Len(郵便番号)の条件が違うだけなので、
練習を兼ねて、作ってみてください。
/*
* ４．演算フィールドで−を取り除く
*/
次は、少し面倒な、７桁の郵便番号から−を取って、
頭５桁の（上から５桁の）データテーブルを作成します。
操作したいデータ、そのままのデータを判断しやすいように、
まず紙に
実データ（想像データでも可能）元データ
と
変換後のデータ
のパターンを書きます（変換パターンを洗い出します）
元 変換後
001-0854 --＞ 00108 ３＋４桁の通常データ、−を取り、５桁にする
102-01 ----＞ 10201 ３＋２桁の過去データ、−を取り除く
0014567 ---＞ 00145 −無しの７桁データ、そのまま５桁取る
12398 -----＞ 12398 −無しの５桁データ、なにもしない
123 -------＞ 123 ３桁のデータ、何もしない、※データも追加しない
001-0854
と
102-01
の時の判断は、４文字目が−か判断して、
頭から（左から）３文字＋５文字目から２文字を抜き出し＋すれば作れそうです。
４文字目が−じゃない時のデータは、
左から５文字をそのまま取れば作れそうです。
便利な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など、３桁の郵便番号も表示されてますね。
Len(郵便番号) が >4 と条件を入れないとね
その後、テーブル作成のクエリーに変更して、
（メニューからクエリ・テーブル作成を選択します）
テーブルを作成するクエリーが完成します。
誤算なのは、
郵便番号:IIf(Mid([郵便番号],4,1) = "-",
Left([郵便番号],3) & Mid([郵便番号],5,2), Left([郵便番号],5))
とすると、循環参照のエラーが発生するので、
変換後郵便番号としているため、
仕様書通りのフィールド名でテーブルを作成できませんでした。
↑循環参照のエラー発生イメージ
-【けんぞう！】---------------------------------------------------------
ASPが利用可能なレンタルサーバーをお探しのアナタ、
http://www.ken3.org/asp/server.html ← けんぞうも使っているサーバーの紹介
『おっIISでbasp21でメール送信、mdbも使えるよ』（三流ＰＧ：31歳）
------------------------------------------------------------------------
/*
* ５．終わりの挨拶
*/
今回は、
テーブル作成クエリーをと使用して、
クエリーからテーブルを作成してみました。
ポイントは、
^^^^^^^^^^^^
普通に表示用のクエリーを作成する。
クエリーのモードをテーブル作成に変更、作成するテーブル名を入れる。
そんな感じの流れで作成可能です。
今回の、サンプルファイルは、
http://www.ken3.org/vba/lzh/vba135.lzh
にdb135.mdb(Access2000版)が保存されています。
※クエリーやデータをいじって、遊んでみてください。
う〜ん、まだまだだなぁ・・・
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜Access テーブル追加クエリーを使用してみた＞
こんにちは、三流プログラマーのＫｅｎ３です。
前回、
テーブル作成クエリーを使用して、
既存のデータからテーブルを作成してみました。
今回は、クエリーの検索結果を別テーブルへ追加する、
追加クエリーを使用してみたいと思います。
今回の、サンプルファイルは、
http://www.ken3.org/vba/lzh/vba136.lzh
にdb135.mdb(Access2000版)が保存されています。
※クエリーやデータをいじって、遊んでみてください。
/*
* １. 今回のキッカケ
*/
No.135 Access テーブル作成クエリーを使用してみた
http://www.ken3.org/backno/backno_vba28.html#135
で、
郵便番号別のテーブルを作成しました。
今回は、集計を行い、ある条件（１０以下のデータ）
を別のテーブルのデータに追加してみたいと思います。
/*
* ２．処理の仕様
*/
処理の流れ、仕様は下記のような感じです。
作成方法・方針の詳細は、
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
と、集計します。
ここで、カウント数によって２つの分かれ道、
10以上は、そのままExcelへデータセットに使います。
10回以下は、頭３桁の番号とカウント数を、YUBIN_DATA3テーブルへ追加します。
集計結果の、
10100 5
10106 4
を
YUBIN_DATA3 に追加します
~~~~~~~~~~~
郵便番号 数
001 1 (※１もともとセットされているデータ)
061 1 ( 〃 )
101 1 ( 〃 )
101 5 (YUBIN_DATA5の集計クエリーから10100集計5のデータ)
101 4 (YUBIN_DATA5の集計クエリーから10106集計4のデータ)
※郵便番号101数5 と 郵便番号101数4のデータが追加される
なんて処理を、追加クエリーを使用して、作成してみます。
/*
* ３．追加クエリーの作成方法
*/
まぁ、追加クエリーなんて、カッコよく言っているけど、
手順としては、まず、追加するデータをセレクト・選択しないとね。
（選択された、ある条件のデーターを追加、そんなパターンなので）
普通に集計クエリーを作成します
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
YUBIN_DATA5テーブルに対して、
変換後郵便番号をグループ化してカウントします。
変換後郵便番号 変換後郵便番号のカウント
10800 2
11200 19
11300 13
↑グループ化して、カウントしたクエリー
追加したいデータは、１０以下のデータなので、条件<10を追加する。
それと、３桁のデータにして追加したいので、
YUBIN3桁:Left([変換後郵便番号])と式を追加して１つフィールドを作成します。
※ポイントは、集計項目でLeftなど計算しているところを演算にします
↑グループ化して、カウント、条件10以下、左から３桁の項目(演算)作成
変換後郵便番号 変換後郵便番号のカウント 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以下のデータを追加することができます。
/*
* ４．カウントから集計へ
*/
同様に、YUBIN_DATA3を集計して、10以下のデータをYUBIN_DATA2へ追加します。
ポイントは、
^^^^^^^^^^^^
いままで、郵便番号でグループ化、郵便番号のカウント（数を数える）
で、集計していたのですが、
YUBIN_DATA3 テーブルの構造は（作りは）
~~~~~~~~~~~
郵便番号 数
001 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 いろいろとあるので転機の人はぜひ
登録料無料、匿名で探せるので在宅でアルバイト、副業の人も見てね
------------------------------------------------------------------------
/*
* ４．終わりの挨拶
*/
今回は、
追加クエリーを使用して、
他のテーブルにデータを追加してみました。
ポイントは、
^^^^^^^^^^^^
普通に表示用のクエリーを作成する。
クエリーのモードを追加に変更、追加するテーブル名とフィールドを選択。
そんな感じの流れで作成可能です。
あとは、このテーブルから、ExcelへデータをセットすればOKですね。
今回の、サンプルファイルは、
http://www.ken3.org/vba/lzh/vba136.lzh
にdb136.mdb(Access2000版)が保存されています。
※クエリーやデータをいじって、遊んでみてください。
う〜ん、まだまだだなぁ・・・
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜Access クエリーを連続で実行させる＞
こんにちは、三流プログラマーのＫｅｎ３です。
前回、までで、やっとテーブル作成・データ作成ができました。
今回は、その作成したクエリーを連続で実行させてみたいと思います。
/*
* １. 今回のキッカケ
*/
No.135 Access テーブル作成クエリーを使用してみた
http://www.ken3.org/backno/backno_vba28.html#135
で、
郵便番号別のテーブルを作成しました。
No.136 Access テーブル追加クエリーを使用してみた
http://www.ken3.org/backno/backno_vba28.html#136
で、
集計数が１０以下のデータを別テーブルへ追加する、
追加クエリーを作成しました。
今回は、作成したクエリーを連続で実行してみます。
※前回までは、作業者が手でクエリーをダブルクリックなどで実行してたけど、
まとめて実行してみたいと思います。
/*
* ２．マクロで機能を実現してみる
*/
ある決まった処理をまとめて行う。
そんな時便利なのがAccessにもあるマクロです。
（※マクロ=ＶＢＡと思いがちですが、ここでは、
Accessのマクロ機能で攻めてみます）
新規でマクロを作成し、
アクションでクエリを開くを選択します。
↑マクロのアクション選択画面
次に、アクションのパラメータを入れます。
開きたいクエリー名をセットします。
↑クエリー名称の入力
ここまでで、１つのクエリーを開けたので、
順番に、
クエリを開く MAKE_DATA5
クエリを開く MAKE_DATA3
クエリを開く MAKE_DATA2
クエリを開く DATA5から10以下のデータをDATA3へ追加
クエリを開く DATA3から10以下のデータをDATA2へ追加
と、作成します。
開く順番を間違えなければＯＫでしょう。
実行すると、確認メッセージが表示されるが、なんとか動きました。
・テーブル作成クエリを実行すると新しくテーブルが作成されます
や
・XX件のデータを追加します
なんてメッセージ、表示をやめたいですよね。
そんな時は、マクロのアクションで、
メッセージの設定をいいえにすると、メッセージが出なくなります。
↑アクションにメッセージの表示を追加する
/*
* ３．マクロをモジュールに変換して、コードを見てみる
*/
マクロが出来たので、今度は、そのマクロを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円、タバコなら２箱、120円缶コーヒーなら４缶分の謝礼をＧｅｔするなら
http://www.ken3.org/etc/500yen/ ←無料アンケート系の広告です。
『チッ、がんばって回答して月500円かよ』（お馬鹿なプログラマー：31歳）
※家族４人分の登録でも月2000円、、、なんとかプロバイダー代くらいかなぁ。
------------------------------------------------------------------------
/*
* ４．終わりの挨拶
*/
今回は、
作成したクエリーを連続実行させるために、
マクロを作りました。
さらにおまけで、マクロからモジュールを作成して、
命令を探ってみました。
残るは、Excelへデータをセットですね。
う〜ん、まだまだだなぁ・・・
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜AccessからExcel出力、色・列幅・行の高さを調整する＞
こんにちは、三流プログラマーのＫｅｎ３です。
郵便番号データの集計処理もいよいよ終盤戦です。
今回の、サンプルファイルは、
http://www.ken3.org/vba/lzh/vba138.lzh
にdb138.mdb(Access2000版)が保存されています。
※クエリーやデータをいじって、遊んでみてください。
Access から Excel 連携
http://www.ken3.org/cgi-bin/group/vba_access_excel.asp
も参考にしてください。
/*
* １. 今回のキッカケ
*/
前回、までで、なんとか、出力用のデータをそろえられました。
※ここまでに、かなり時間がかかりましたが。
今回は、
AccessからExcelへ出力時に、
セルに色を付けたり、列幅・行の高さを設定してみたいと思います。
/*
* ２．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などで、作ってもＯＫかなぁ。
列幅は、
^^^^^^^^
Columns("A:A").Select で列選択、
Selection.ColumnWidth = 8 で、幅を設定。
※選択処理しないで、直接設定も可能です。
行の高さは、
^^^^^^^^^^
Rows("2:4").Select で、行選択、
Selection.RowHeight = 16 で、行の高さを設定
あとの詳細は、ヘルプを見る。
そんな感じで探れそうです。
/*
* ３．Excelの出力処理に組み込む
*/
[No.131 Access クエリーをExcelシートへ罫線を付けて出力する]
http://www.ken3.org/backno/backno_vba27.html#131
罫線付で、データをExcelへ出力してみました。
この処理に、
今回調べた、色を付ける処理、列幅、行の高さ、３つの機能を追加してみます。
まず列幅から、処理していきたいと思います。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
(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、Ｂ列は15など幅は縦に設定するので
シートを作成したときに設定してみます。
郵便番号と件数の列を8.5、空白列を1.8に設定します。
For文で、３列単位で回してみました。
'列幅は、縦なので、ここ、頭で定義する
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
こんな感じで、３列単位に、列幅を設定しました。
次は、行の高さです
^^^^^^^^^^^^^^^^^^
行の高さは、見出しの文字列、罫線を引いた後にセットしてみたと思います。
見出しの高さを２５、データの高さを１６に設定します。
'行の高さを調整する
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が１だとするとRows(1).RowHeight = 25としてます。
~~~~~~~~~~~~~~~~~~~~
次がデータ行です。
Rows("2:4").Select で、２〜４行選択、だったので、
：コロンで区切った文字列を作成して、指定します。
見出しの次の行から指定なので、
strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '10行分の範囲文字列
と
１０行分の範囲 2:11を作成して、
Rows(strWORK)で範囲を指定、
.RowHeight = 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
セルにマクロ記録で調べたカラーインデックスの３３をセットしてます。
↑実行結果です、なんとかここまでできました。
部分的に考えると、なんとかなりそうですね。
組み込んだ、長いセットのソースは、下記のような感じです。
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 '１行目だよ
nXLINE = 1 '１列目（A列）だよ
'見出しをセットする
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
'罫線を引く(見出しの位置から＋１０行分)
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 '見出し表示後は１レコード目だよ
'レコードセットから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列目（Ａ列）に戻す
nYLINE = nYLINE + 2 '空白行にしたいのでセット位置を＋２する
Else
nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする
End If
'見出しの表示
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
'罫線を引く(見出しの位置から＋１０行分)
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 '見出し表示後は１レコード目だよ
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円、タバコなら２箱、120円缶コーヒーなら４缶分の謝礼をＧｅｔするなら
http://www.ken3.org/etc/500yen/ ←無料アンケート系の広告です。
『チッ、がんばって回答して月500円かよ』（お馬鹿なプログラマー：31歳）
※家族４人分の登録でも月2000円、、、なんとかプロバイダー代くらいかなぁ。
------------------------------------------------------------------------
/*
* ４．終わりの挨拶
*/
今回は、
AccessからExcelへの出力で、
列幅の変更、行の高さの変更、セルの背景色の変更
をやりました。
今回の、サンプルファイルは、
http://www.ken3.org/vba/lzh/vba138.lzh
にdb138.mdb(Access2000版)が保存されています。
※クエリーやデータをいじって、遊んでみてください。
あとは、連続してデータをセットですね。
う〜ん、まだまだだなぁ・・・
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜AccessからExcel出力、複数クエリーを１シートへ＞
こんにちは、三流プログラマーのＫｅｎ３です。
郵便番号データの集計処理もいよいよ終盤戦です。
今回の、サンプルファイルは、
http://www.ken3.org/vba/lzh/vba139.lzh
にdb139.mdb(Access2000版)が保存されています。
※クエリーやデータをいじって、遊んでみてください。
Access から Excel 連携
http://www.ken3.org/cgi-bin/group/vba_access_excel.asp
も参考にしてください。
/*
* １. 今回のキッカケ
*/
前回、までで、
・出力用のデータをそろえる
・罫線、色、列幅、行の高さ・・などのセット方法
そんな感じの単体テストがやっと終わってます。
今回は、
AccessからExcelへ出力で、
複数のクエリーを１つのシートに出力してみます。
/*
* ２．クエリーを４つ用意する
*/
集計の仕様は、こんな感じでした。
No.133 仕様変更が来たら？落胆しないで前向きに？
http://www.ken3.org/backno/backno_vba27.html#133
で、
集計方法を考えました。※良い悪い、は、置いといて（笑）
>１.郵便番号の上から５桁を番号別に集計して･･･
>
>２.５桁で集計したものの中で１０通以下（９〜１通）になったものを
> 今度は上から３桁で集計する
>
>３.３桁で集計したものの中で１０通以下（９〜１通）になったものを
> 今度は上から２桁で集計する
>
>４.２桁で集計したものの中で１０通以下（９〜１通）になったものを
> △△△と言う名前で集計する
MOTO_DATA テーブルに住所付の郵便番号データ
から
YUBIN_DATA5 上５桁に削ったデータ
YUBIN_DATA3 ３桁のデータとYUBIN_DATA5で10以下の番号
YUBIN_DATA2 ２桁のデータとYUBIN_DATA3で10以下の番号
と、テーブルを３つ作成しました。
上記の３つのテーブルから４つのクエリーを作成します
Q_YUBIN5 「５桁集計結果１０件以上のみ」
^^^^^^^^
YUBIN_DATA5を郵便番号でグループ集計して、
数が１０以上のデータを表示します。
~~~~~~~~~~~~
番号 通数
10701 11
11200 19
11300 13
集計クエリーでフィールド名を番号、通数として作ってます。
番号: 変換後郵便番号
として、フィールド名を変更してます
↑作成したクエリービルダーの様子
Q_YUBIN3 「３桁集計結果１０件以上のみ」
^^^^^^^^
YUBIN_DATA3を郵便番号でグループ集計して、
数が１０以上のデータを表示します。
~~~~~~~~~~~~
番号 通数
107 17
113 11
135 13
集計クエリーでフィールド名を番号、通数として作ってます。
↑作成したクエリービルダーの様子
Q_YUBIN2 「２桁１０件以上」
^^^^^^^^
YUBIN_DATA2を郵便番号でグループ集計して、
数が１０以上のデータを表示します。
~~~~~~~~~~~~
番号 通数
11 14
16 23
17 13
集計クエリーでフィールド名を番号、通数として作ってます。
↑作成したクエリービルダーの様子
Q_YUBIN_ETC 「２桁１０件以下」
^^^^^^^^
YUBIN_DATA2を郵便番号でグループ集計して、
数が１０以下（1〜9）のデータを表示します。
~~~~~~~~~~~~~~~~~~~
番号 通数
00 1
06 1
10 8
集計クエリーでフィールド名を番号、通数として作ってます。
↑作成したクエリービルダーの様子
やっと、４つのクエリーが作成できました。
/*
* ３．Excelの出力処理に組み込む
*/
[No.138 AccessからExcel出力、色・列幅・行の高さを調整する]
http://www.ken3.org/backno/backno_vba28.html#138
色や列幅、高さを変える方法を上記で探りました、
この処理に、
今回作成した４つのクエリーを使い、データを追加してみます。
青(37) Q_YUBIN5 ----- 「５桁集計結果１０件以上のみ」
水色(34) Q_YUBIN3 ----- 「３桁集計結果１０件以上のみ」
黄色(36) Q_YUBIN2 ----- 「２桁１０件以上」
緑(35) Q_YUBIN_ETC -- 「２桁１０件以下」
の４色(カッコ内はカラー番号)で、出力してみたいと思います。
単純に、縦に並べてクエリーの出力を作成すると、
こんな感じになります。
※長いだけのテク無しプログラムだね・・・
↑作成結果
下記、長いだけのコピープログラム（笑）
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 '１行目だよ
nXLINE = 1 '１列目（A列）だよ
'見出しをセットする
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
'罫線を引く(見出しの位置から＋１０行分)
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 '見出し表示後は１レコード目だよ
'------------------------------------------------------------
'青(37) Q_YUBIN5 「５桁集計結果１０件以上のみ」セット処理
'------------------------------------------------------------
'レコードセットを開く(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列目（Ａ列）に戻す
nYLINE = nYLINE + 2 '空白行にしたいのでセット位置を＋２する
Else
nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする
End If
'見出しの表示
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
'罫線を引く(見出しの位置から＋１０行分)
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 '見出し表示後は１レコード目だよ
Else '
nYLINE = nYLINE + 1 '次の行へセット位置を移動
End If
Wend
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
'------------------------------------------------------------
'水色(34) Q_YUBIN3 「３桁集計結果１０件以上のみ」セット処理
'------------------------------------------------------------
'レコードセットを開く(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列目（Ａ列）に戻す
nYLINE = nYLINE + 2 '空白行にしたいのでセット位置を＋２する
Else
nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする
End If
'見出しの表示
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
'罫線を引く(見出しの位置から＋１０行分)
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 '見出し表示後は１レコード目だよ
Else '
nYLINE = nYLINE + 1 '次の行へセット位置を移動
End If
Wend
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
'------------------------------------------------------------
'黄色(36) Q_YUBIN2 「２桁１０件以上」セット処理
'------------------------------------------------------------
'レコードセットを開く(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列目（Ａ列）に戻す
nYLINE = nYLINE + 2 '空白行にしたいのでセット位置を＋２する
Else
nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする
End If
'見出しの表示
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
'罫線を引く(見出しの位置から＋１０行分)
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 '見出し表示後は１レコード目だよ
Else '
nYLINE = nYLINE + 1 '次の行へセット位置を移動
End If
Wend
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
'------------------------------------------------------------
'緑(35) Q_YUBIN_ETC 「２桁１０件以下」セット処理
'------------------------------------------------------------
'レコードセットを開く(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 |
/*
* ４．配列を使ってまとめる
*/
コピープログラム（笑）
なんて笑ってないで、修正しろよ。
ですよね、チョット前、
[作成時 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 ----- 「５桁集計結果１０件以上のみ」
水色(34) Q_YUBIN3 ----- 「３桁集計結果１０件以上のみ」
黄色(36) Q_YUBIN2 ----- 「２桁１０件以上」
Arrayで初期化してもいいけど、：（コロン）で１行に２命令書いてみます。
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 '１行目だよ
nXLINE = 1 '１列目（A列）だよ
'見出しをセットする
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
'罫線を引く(見出しの位置から＋１０行分)
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 '見出し表示後は１レコード目だよ
'------------------------------------------------------------
'３つのクエリーを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列目（Ａ列）に戻す
nYLINE = nYLINE + 2 '空白行にしたいのでセット位置を＋２する
Else
nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする
End If
'見出しの表示
objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
'罫線を引く(見出しの位置から＋１０行分)
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 '見出し表示後は１レコード目だよ
Else '
nYLINE = nYLINE + 1 '次の行へセット位置を移動
End If
Wend
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
Next nQCNT
'------------------------------------------------------------
'緑(35) Q_YUBIN_ETC 「２桁１０件以下」セット処理
'------------------------------------------------------------
'レコードセットを開く(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円、タバコなら２箱、120円缶コーヒーなら４缶分の謝礼をＧｅｔするなら
http://www.ken3.org/etc/500yen/ ←無料アンケート系の広告です。
『チッ、がんばって回答して月500円かよ』（お馬鹿なプログラマー：31歳）
※家族４人分の登録でも月2000円、、、なんとかプロバイダー代くらいかなぁ。
------------------------------------------------------------------------
/*
* ５．終わりの挨拶
*/
今回は、
複数のクエリーを１つのシートに出力してみました。
※クエリー単位で色を変えて。
プログラムの組み方も、コピーで適当に作らないで、
ループで作る・・なんて感じのことも少々。
今回の、サンプルファイルは、
http://www.ken3.org/vba/lzh/vba139.lzh
にdb139.mdb(Access2000版)が保存されています。
※クエリーやデータをいじって、遊んでみてください。
あとは、インポートファイル名の選択やテストですね。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
検索して目的の情報を探す。
目的の情報を探すには、最近はググれとよく聞きます。なので、検索ボックスを付けました。
いろいろなキーワードを入れて、検索してみてください。
ページフッター
ここまで、読んでいただきどうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。
質問や要望など メッセージを送る(三流君に連絡する)
質問や要望など連絡方法でお互い確認が取りやすく、便利なのが掲示板なのですが、私の対応のまずさから不定期で荒れてしまい、掲示板は現在封鎖中です。(反省しなきゃ)
|
|
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。
|
急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。
リンクや広告など
項目別に↓に人気の記事をまとめてみました。お探しのジャンルを選択してください。
人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記３つみたいな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系バックナンバー目次へ移動]
