[三流君] −−＞ [ＶＢＡで楽しく] −−＞ [バックナンバー一覧]
−−＞ No.139 AccessからExcel出力、複数クエリーを１シートへ

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

メルマガ発行内容

＜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で他のアプリケーションを操作するサンプルが人気です。

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系バックナンバー目次へ移動]