人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

こんばんは。DAOでレコードセットを使ってテーブルを取得します。このテーブルのある列を見てExcelファイルを複数作りたいです。

例えばA列、C列、Z列からselectでデータを抽出してきます。A列には,1,1,1,2,2,2,2,3,3,3,3,3,5,4,9,34,34,11,11など特定の数値が入っています。これを数値別で各excelファイルに書き出して保存したいと思っています。1の塊は1.xls、2の塊は2.xlsなど自動でファイルを生成したいと思っています。selectでorder A列にして塊を作るというところまでは理解できるのですが、ここからどうやって1の塊の終わり、2の塊の終わりを判別して書き出してやるかが思いつきません。具体的に教えていただけたら幸いです。よろしくお願いいたします。

●質問者: akaired
●カテゴリ:コンピュータ インターネット
✍キーワード:Excel SELECT xls データ ファイル
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● sphire
●27ポイント

言語とか不明なので適当に考えた疑似言語で。

全データ = SELECT a列,c列,z列 FROM tbl ORDER BY a;
pre = null; //preの初期値は絶対一致しない値で
foreach(行 in 全データ){
 now = 行[a列]; //a列の値
 if(now != pre){
 file = now . '.xls'; //追記するファイル名
 }
 append(file, 行);
 pre = now; //1つ前の行のa列を保持するのがミソ
}

URLはダミーです

http://hoge/

◎質問者からの返答

VBAです


2 ● たっぷ
●27ポイント

ぱっと見では、二つの方法があります。開発環境や言語等が分からないため簡単に説明だけ書きます。

1. 数字毎のレコード数を求める SELECT 文を発行する。

対象のデータをorder A列で抽出後、数字毎のレコード数を元にしてファイルを作成する処理を行う。

2. order A列で抽出後、ループしてファイルを作成する際に、一つ前のレコードの A列の値を現在の A列の値と比較して違っていたら次のファイルとする。

こんな感じになると思います。説明だと分かり難いと思いますが、実際にコーディングしてみたら難しくはないです。

ちなみに、Excelファイルの生成は、出来ているという前提でよいのでしょうか?

http://www.hatena.ne.jp/ ダミーです。

◎質問者からの返答

VBAです。ありがとうございます。具体的にコードも教えていただけたらと思います。


3 ● SALINGER
●400ポイント ベストアンサー

具体的なコードを作ってみました。

やっていることは、他の人の回答とそんなに違いません。

A列の値を取得して、その前に取得した値と比較して、違ったら表を整形して保存し、新たにブックを追加し、見出し行を書き込みます。A列の値が同じならばそのままデータを書き込むという動作をレコードごとに繰り返します。レコードが無くなった時点で今開いているブックを保存するという動作も必要となります。

Option Explicit

Sub Macro()
 Dim db As DAO.Database
 Dim rscset As DAO.Recordset
 Dim mySQL As String
 Dim mySource As String
 Dim i As Long
 Dim j As Integer
 Dim fc As Integer
 Dim myPath As String
 Dim strA As String
 Dim wb As Workbook
 
  'Accessのファイルのパスを指定
 mySource = ThisWorkbook.Path & "\sample.mdb"
 
  '作成されるファイルのパスを指定
 myPath = ThisWorkbook.Path
 
  'テーブルの名前を指定
 Const tableName As String = "テーブル名"
 
  '作成されるブックの開始行を指定
 Const StartRow As Long = 1
 
 Set db = DBEngine.Workspaces(0).OpenDatabase(mySource)
 
  '書き出すフィールド名を指定
 mySQL = "SELECT A列,C列,Z列 FROM " & tableName & " ORDER BY A列"
 
 Set rscset = db.OpenRecordset(mySQL)
 
 fc = rscset.Fields.Count
 
 strA = ""
 
 i = StartRow
  'レコードセットの書き出し
 While rscset.EOF = False
 If rscset.Fields("A列") <> strA Then
 If Not wb Is Nothing Then
  '表の整形
 With wb.Worksheets(1).Range(Cells(StartRow, 1), Cells(i - 1, fc))
 .Borders(xlEdgeLeft).Weight = xlThin
 .Borders(xlEdgeTop).Weight = xlThin
 .Borders(xlEdgeBottom).Weight = xlThin
 .Borders(xlEdgeRight).Weight = xlThin
 .Borders(xlInsideVertical).Weight = xlThin
 .Borders(xlInsideHorizontal).Weight = xlThin
 End With
 wb.SaveAs Filename:=myPath & "\" & strA & ".xls"
 wb.Close
 i = StartRow
 End If
 Set wb = Workbooks.Add
 For j = 1 To fc
 wb.Worksheets(1).Cells(i, j).Value = rscset.Fields(j - 1).Name
 Next j
 i = i + 1
 strA = rscset.Fields("A列")
 End If
 For j = 1 To fc
 Cells(i, j).Value = rscset.Fields(j - 1).Value
 Next
 i = i + 1
 rscset.MoveNext
 Wend
 
  '表の整形
 With wb.Worksheets(1).Range(Cells(StartRow, 1), Cells(i - 1, fc))
 .Borders(xlEdgeLeft).Weight = xlThin
 .Borders(xlEdgeTop).Weight = xlThin
 .Borders(xlEdgeBottom).Weight = xlThin
 .Borders(xlEdgeRight).Weight = xlThin
 .Borders(xlInsideVertical).Weight = xlThin
 .Borders(xlInsideHorizontal).Weight = xlThin
 End With
 wb.SaveAs Filename:=myPath & "\" & strA & ".xls"
 wb.Close
 
 rscset.Close
 Set rscset = Nothing
 
 db.Close
 Set db = Nothing
End Sub

http://q.hatena.ne.jp/

◎質問者からの返答

細かくコードを書いて頂きありがとうございます!嬉しいです、これを読み解き勉強したいと思います。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ