＜シートへデータを転記＞
どうも、三流プログラマーのＫｅｎ３です。 今回は、 AccessからExcelにデータを転記してみます。 ただ、転送するだけだとつまらないので (Docmdで終わってしまうので) データの分類別にシートを作成して、追加してみたいと思います。 たいした内容じゃないのですが。 サンプルファイルは、 http://www.ken3.org/vba/lzh/vba100.lzh にdb100.mdb(Access2000版)が保存されています。 おっと、祝100号？だったか？と思いつつ、 2000本安打は通過点です みたいにさらっと流して（笑） ※なんとかつぶされずにここまで来ました。 なんて書いてて、調子こいてたら、つぶされたりしてね（オイオイ） /* * １．今回のキッカケ */ http://www.ken3.org/cgi-bin/bbs/vba/wforum.cgi の掲示板に、 >タイトル：ＥＸＣＥＬ出力続き >最後の挨拶にある・顧客別にシートを作成して、請求明細を複数転記、 >固定の罫線付きのフォーマットに当てはめる >でやれば尚いいですね、現在の連続出力のやり方で、やるには？？？ ---- と書き込みをもらいました。 No.93 Access2000 ADOでクエリーのレコードを参照 Excelへ出力 http://www.ken3.org/backno/backno_vba19.html#93 で、 Private Sub btnTEST_TO_Excel_Click() Dim rs As New ADODB.Recordset 'ADOのレコードセット Dim objEXCEL As Object 'Excel参照用 'Excelを起動する Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成 objEXCEL.Visible = True 'Excelを見えるようにする objEXCEL.Workbooks.Add 'Excelのブックを作成 'レコードセットを開く(Q_顧客情報) rs.Open "Q_顧客情報", CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic 'ループ処理 While rs.EOF = False 'いつものEOFが偽の間 'Excelのシートを追加、シート名を氏名に変更する objEXCEL.Sheets.Add 'シートを追加する objEXCEL.ActiveSheet.Name = rs.Fields("氏名") '現在のシート名を変更 'データをセットする(Accessから転記) objEXCEL.Range("A1") = "番号は" objEXCEL.Range("B1") = rs.Fields("顧客番号") objEXCEL.Range("A2") = "ポイントは" objEXCEL.Range("B2") = rs.Fields("point") objEXCEL.Range("A3") = "氏名／住所" objEXCEL.Range("B3") = rs.Fields("氏名") objEXCEL.Range("B4") = rs.Fields("住所") rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑) Wend '通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑) Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって? End Sub と １レコード、１シートでデータを作成しました。 今回は、同じグループを１つのシートに転記してみます。 /* * ２．仕様とサンプルデータ */ グループかぁ、、、どんなサンプル用意しようかなぁ。 あっ、前回使用したセリーグの規定打席の打撃データがあるよね。 ※横浜弱いからマシンガン打線のローズの居たころに差し替えたいけど、 面倒だから前回のデータをそのまま使用しよう。 テーブル名は、T_AVG フィールドは、 ID 打率順位 選手名 チーム 打率 試合数 打数 得点 安打 二塁打 三塁打 本塁打 打点 三振 四球 死球 犠打 ----- こんな感じです。 順位 選手名 チーム 打率 試合数 打数 得点 安打 二塁打 三塁打 本塁打 ・・・ 1 今岡 阪神 0.365 75 318 43 116 28 0 6 ・・・・ 2 矢野 阪神 0.352 75 267 46 94 15 4 9 ・・・・ 3 赤星 阪神 0.350 75 297 57 104 10 4 0 ・・・・ 4 高橋由 巨人 0.350 59 223 47 78 17 1 13 ・・・・ 5 ラミレス ヤクルト0.348 75 305 61 106 20 3 24 ・・・・ 6 鈴木 ヤクルト 0.336 74 277 45 93 24 0 11 ・・・・ 7 福留 中日 0.332 76 289 60 96 19 6 14 ・・・・ 8 木村拓 広島 0.330 60 194 24 64 13 0 5 ・・・・ 9 シーツ 広島 0.322 69 261 42 84 19 1 11 ・・・・ 10 金城 横浜 0.314 73 296 38 93 17 1 7 ・・・・ このデータをチーム別のExcelシートに転記してみたいと思います。 ※６つのシートにデータを転記する。 /* * ３．方法いろいろあるけど、レコードセットを回しながらセットしてみます */ 方法は、いろいろとあるんだけど（他の方法は、次のネタに取っといて） 今回は、レコードセットを回しながらセットしてみます。 ア．何も考えないで回しまくる ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ まずは、Excelを起動したら、６つの球団別のシートを作らなきゃね。 その後、球団別にデータをセットしていこうよ。 あとは作りながら考え、場当たり的にプログラム組んで行きますか。 まずは、球団別のシートを作成してみました。 Private Sub btnMAKESHEET_Click() 'Excelを起動する Dim objEXCEL As Object 'Excel参照用 Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成 objEXCEL.Visible = True 'Excelを見えるようにする objEXCEL.Workbooks.Add 'Excelのブックを作成 'シートを６つ作成する Dim strチーム名 As Variant 'チーム名を配列で受け取るタメ Dim n As Integer 'カウンター変数 strチーム名 = Array("横浜", "阪神", "巨人", "ヤクルト", "中日", "広島") 'チーム名のシートを作成する For n = 0 To 5 '0〜5までチーム名を取り出しループ 'Excelのシートを追加、シート名をチーム名に変更する objEXCEL.Sheets.Add 'シートを追加する objEXCEL.ActiveSheet.Name = strチーム名(n) '現在のシート名を変更 Next n End Sub http://www.ken3.org/backno/gif/vba100-01.gif ↑まぁ、順番が逆になったけど、無事６つシートが作成されました。 次は、フィールドのデータを書き込まないとね。 Private Sub btnMAKESHEET_Click() 'Excelを起動する Dim objEXCEL As Object 'Excel参照用 Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成 objEXCEL.Visible = True 'Excelを見えるようにする objEXCEL.Workbooks.Add 'Excelのブックを作成 'シートを６つ作成する Dim strチーム名 As Variant 'チーム名を配列で受け取るタメ Dim n As Integer 'カウンター変数 strチーム名 = Array("横浜", "阪神", "巨人", "ヤクルト", "中日", "広島") 'チーム名のシートを作成する For n = 0 To 5 '0〜5までチーム名を取り出しループ 'Excelのシートを追加、シート名をチーム名に変更する objEXCEL.Sheets.Add 'シートを追加する objEXCEL.ActiveSheet.Name = strチーム名(n) '現在のシート名を変更 Next n 'データを転記する Dim rs As New ADODB.Recordset 'ADOのレコードセット Dim strTNAME As String Dim y As Integer, x As Integer 'セット位置 'レコードセットを開く(テーブルT_AVGを開く) rs.Open "T_AVG", CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic 'ループ処理 While rs.EOF = False 'いつものEOFが偽の間 'Excelのシート、チームをアクティブシートにする strTNAME = rs.Fields("チーム") 'チーム名を取り出す objEXCEL.Sheets(strTNAME).Select 'シート名を指定して選択 'データセット位置を探す（馬鹿っぽく（笑）） y = 1 While objEXCEL.Cells(y, 1) <> "" '空白以外の時まわす(空白までループ) y = y + 1 '次の行にする Wend 'データをセットする x = 1 For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする objEXCEL.Cells(y, x) = rs.Fields(n).Value 'n番目のフィールド値をセット x = x + 1 '列を＋１する（次の列へ） Next n rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑) Wend '通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑) Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって? End Sub http://www.ken3.org/backno/gif/vba100-02.gif ↑無事データを書き込めました６つの球団別にデータが作成されました。 じゃないでしょ、解説は？解説？ まぁ、アンタの解説聞いてもよくわかんないけど、書いてよ。 ムカっ(AB型の変わり者、右脳と左脳のケンカは置いといて*気にしないでね) えっと、ポイントは、 ~~~~~~~~~~~~~~~~~~~~ 'レコードセットを開く(テーブルT_AVGを開く) rs.Open "T_AVG", CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic で、T_AVGのテーブルを開いてます。 'ループ処理 While rs.EOF = False 'いつものEOFが偽の間 --- ここにレコード転記の処理 --- rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑) Wend で、レコードがなくなるまでループさせます。 まずは、チーム別にシートが分かれているので、 そのチーム別のシートをアクティブにします（選択します） 'Excelのシート、チームをアクティブシートにする strTNAME = rs.Fields("チーム") 'チーム名を取り出す objEXCEL.Sheets(strTNAME).Select 'シート名を指定して選択 rs.Fields("チーム")にチーム名が入っているので、変数に保存し、 objEXCEL.Sheets(strTNAME).Select で、その名前のシートをセレクト（選択）してます。 次に、シートが選択されたら、データを転記したいので、 セットする行（場所）を探します。 'データセット位置を探す（馬鹿っぽく（笑）） y = 1 While objEXCEL.Cells(y, 1) <> "" '空白以外の時まわす(空白までループ) y = y + 1 '次の行にする Wend ここの処理は、Ｙ＝１と一行目にカウンターをセットして、 objEXCEL.Cells(y, 1) <> ""の空白セルを条件にしてループを回し、 ループ内でy=y+1とカウンタ次の行にして、空白セルまでｙをカウントします。 ※最初はｙ＝1でループを抜けます。次は1,1にデータがあるので２まで・・ の繰り返しです。 ｙ（行）が求まったので、データをセットします。 'データをセットする x = 1 For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする objEXCEL.Cells(y, x) = rs.Fields(n).Value 'n番目のフィールド値をセット x = x + 1 '列を＋１する（次の列へ） Next n ここでは、ｘ（列）のカウンターを１に初期化後、 For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする と、.Fields.Countでレコードセットのフィールド数を求め−１（０からなので） までループさせ、 objEXCEL.Cells(y, x)のデータ位置に rs.Fields(n).Value n番目のフィールドデータをセットしてます。 レコードセットのフィールドへのアクセスは、 rs.Fields("チーム") とフィールド名を使用する方法と rs.Fields(n) みたいに、ｎ番目と指定する方法があります。 フィールドを全て転記したかったので、 rs.Fields(n)のアクセス方法で回してセットしました。 /* * ４．チーム別に並べ直してからデータをセットする */ サスガ三流プログラマー、工夫のかけらも無いよね。 いいじゃん、動いてんだからさ。 そんなプログラムをもしかして参考にするプログラマーが居たらどうすんの？ 世の中に三流プログラマーをこれ以上増やさないでくださいよ。 ※だから、調子こいてる・・ＨＰつぶすとか言われるんだよ？（ホントかよ？） ちぇ、昔やってたキーが変わったら〜、 コントロールブレイクの集計処理じゃないけど それっぽく作ってみますか。 イ．チーム別にデータを並べ、チーム単位に処理を行う 基本方針を少し変更し、データをまずチーム別にオーダー（select）します で、チーム単位にシートにそのまま転記してみます。 Private Sub btnMAKESHEET2_Click() 'Excelを起動する Dim objEXCEL As Object 'Excel参照用 Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成 objEXCEL.Visible = True 'Excelを見えるようにする objEXCEL.Workbooks.Add 'Excelのブックを作成 Dim strTNAME As String 'チーム名を管理する Dim y As Integer, x As Integer 'セット位置 Dim n As Integer 'カウンター変数 'レコードセットを開く(テーブルT_AVGを開く) Dim rs As New ADODB.Recordset 'ADOのレコードセット Dim strSQL As String 'SQL文 'T_AVGテーブルから全ての項目、レコードの順はチーム,打率順位とする strSQL = "Select * From T_AVG Order BY チーム, 打率順位" rs.Open strSQL, CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic 'ループ処理 strTNAME = "横浜大洋ホエールズ" '一致しない値で初期化（笑） While rs.EOF = False 'いつものEOFが偽の間 'チームが変わったかをチェックする If strTNAME <> rs.Fields("チーム") Then 'チーム名を比べる strTNAME = rs.Fields("チーム") '変わったチーム名をセットする 'Excelのシートを追加、シート名をチーム名に変更する objEXCEL.Sheets.Add 'シートを追加する objEXCEL.ActiveSheet.Name = strTNAME '現在のシートをチーム名に変更 'おまけで先頭行にフィールド名をセット y = 1 '行カウンタを先頭行にする x = 1 For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする objEXCEL.Cells(y, x) = rs.Fields(n).Name 'n番目field名をセット x = x + 1 '列を＋１する（次の列へ） Next n End If 'データセット位置を次の行にする y = y + 1 '次の行にする 'データをセットする レコード -- シートへ転記 x = 1 For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする objEXCEL.Cells(y, x) = rs.Fields(n).Value 'n番目Field値をセット x = x + 1 '列を＋１する（次の列へ） Next n rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑) Wend '通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑) Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって? End Sub 処理のポイントは、 ^^^^^^^^^^^^^^^^^^ 'Excelを起動する Dim objEXCEL As Object 'Excel参照用 Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成 objEXCEL.Visible = True 'Excelを見えるようにする objEXCEL.Workbooks.Add 'Excelのブックを作成 の起動部分は、一緒ですが、ここから先が一味違う。 'レコードセットを開く(テーブルT_AVGを開く) Dim rs As New ADODB.Recordset 'ADOのレコードセット Dim strSQL As String 'SQL文 'T_AVGテーブルから全ての項目、レコードの順はチーム,打率順位とする strSQL = "Select * From T_AVG Order BY チーム, 打率順位" rs.Open strSQL, CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic データの取り方をT_AVGテーブル直接から、 SQL文で、 Select * From T_AVG Order BY チーム, 打率順位 と、データを並べなおしてチーム, 打率順位によこせよとオーダーします。 データの順番が、チーム別の順番になっているので、 チーム単位の転記、シート単位で転記する処理を狙っています。 ループ処理では、まず初期化処理で、 strTNAME = "横浜大洋ホエールズ" '一致しない値で初期化（笑） と、チーム名を管理する変数に、一致しない値を代入します。 シャレで、横浜大洋ホエールズと今実在しないチーム名を入れてますが、 strTNAME = ""がキレイな作り方です。この初期化の狙いは、 'チームが変わったかをチェックする If strTNAME <> rs.Fields("チーム") Then 'チーム名を比べる ここで、初回にstrTNAME = "横浜大洋ホエールズ"とフィールドのチームを比べるので、 <>の不一致のIf文にかかります。 strTNAME = rs.Fields("チーム") '変わったチーム名をセットする で、まず、チーム名を代入してます。 次は、チーム名が変わったので、そのチーム向けのシートを作らなきゃ 'Excelのシートを追加、シート名をチーム名に変更する objEXCEL.Sheets.Add 'シートを追加する objEXCEL.ActiveSheet.Name = strTNAME '現在のシート名をチーム名に変更 と、.Sheets.Add , ActiveSheet.Name を使用してチーム名のシートが出来上がる。 'おまけで先頭行にフィールド名をセット y = 1 '行カウンタを先頭行にする x = 1 For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする objEXCEL.Cells(y, x) = rs.Fields(n).Name 'n番目のフィールド名をセット x = x + 1 '列を＋１する（次の列へ） Next n おまけだけど、シートを追加したので、 先頭行にrs.Fields(n).Nameと.Nameフィールド名を表示させてます。 End If 上記で、チーム名が変わったら、 シートを追加、名前の変更、先頭行にフィールド名 の初期処理を行ってます、 アクティブシートは追加したシートになっているので、切り替える必要は無く、 データのセット位置も先頭行からなので、探す必要が無いです。 'データセット位置を次の行にする y = y + 1 '次の行にする なので、↑のように、そのまま、セット位置を＋１（次にしてます。） チームが変わった時、Y=1先頭行と初期化されているので、２となります。 チームが変わらなければ、アクティブシートもそのまま、Y位置が+1され、 データセットする位置が次行に変わる、そんな仕組みです。 'データをセットする レコード -- シートへ転記 x = 1 For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする objEXCEL.Cells(y, x) = rs.Fields(n).Value 'n番目のフィールド値をセット x = x + 1 '列を＋１する（次の列へ） Next n 上記は、そのままレコードをシートに転記してます。 rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑) で、次のレコードに移動し、 Wend ループの頭に戻り、EOFのチェック。 その後、また、チームが変わったかを１レコード単位でチェックしながら、 データの転記処理を行います。 これが昔の先輩がたまに口にする、 コントロールブレーク処理 や キーが変わったタイミングで処理しろ って感じの言葉です。 ※人によってループの作り方、まだまだイロイロとクセや工夫があるんだけど。 ※今の会社の教育体制に疑問を感じた、ボーナス少なかった・・なんて人は、 匿名で自分の価値を下記で探ってみては？ まぁ、辞めても地獄、残っても飼い殺しかもしれないけど・・・ -【けんぞう！】--------------------------------------------------------- 転職関係、在宅プログラマー、SOHOの広告まとめました、匿名で職探せます。 http://www.ken3.org/etc/500yen/zaitaku.html いろいろとあるので転機の人はぜひ 『だだ、広告料稼ぎたいだけだろ、紹介料300円〜1000円の小金稼ぎ』 ギクっ、、、バレた（笑）登録料無料、匿名で探せるので在宅で小金稼ぎの人も見てね ------------------------------------------------------------------------ ※ボーナス後なのか、登録件数月末から４件もあった・・・ 残るのも選択肢の一つと考えつつ、探してみてください。 出て行ってもいいことあるかもしれないし、無いかもしれないよ・・・ /* * ５．終わりの挨拶 */ 今回は、 横浜大洋ホエールズで変数を初期化する って話でした。 オイオイ、違うだろ、 今回は、 グループ別のデータをシートに転記するサンプルでした。 無条件にループさせてデータをセットする方法 と 並べ直してから、グループ単位に処理する。 そんなサンプルを書いてみました。 昔のCOBOLの教科書、そんなレコード処理（ソート後にキーによって） が載っているので、言語わからなくても一度見てみると、面白いですよ。 ※Accessから、やってると、集計処理に=Sumとか、 レポートにグループ化なんてあって、とても便利なので(楽しているので)、 自分でちょっと集計すればできるのに(少し工夫すればできるのに)、 Accessレポートではできません・・とすぐにギブアップで白旗降参するボウヤ達。 仕様書書いてるCOBOLのおじちゃん達は怒っちゃうよ、キット。 そんな集計処理も作れないのかAccess世代は・・・とか・・・ （＊Accessから入った、できる若者プログラマーも多いので、決め付けないでね） ※みんながみんな、VBAのプログラム作成を目指さなくってもねぇ。 Access集計簡単でいいんじゃないの？ プロや複雑な集計したい人だけVBAでレコードセット作って、 自分でループさせるので。 アンマ、Access USERを怒らせるなよ三流のクセに・・・ なんて、怒られそうなので、このへんで。 (AB型の変わり者作者の右脳と左脳がケンカは置いといて*気にしないでね) サンプルファイルは、 http://www.ken3.org/vba/lzh/vba100.lzh にdb100.mdb(Access2000版)が保存されています。 実際にイタズラしてみてください。 独り言は置いといて、何かの参考となれば幸いです。 ~~~~~~~~~~~~~~~~~~ Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、
|
気になったジャンル↓を選択してください。 人気記事(来場者が多いTOP3): Excel関係: Access関係: その他：VBAの共通関数やテキストファイルの操作など 開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う] 仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力] ※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。 |
Blogとリンク:[三流君の作業日記]/
[VBAやASPのサンプルコード]/
広告-[通販人気商品の足跡]