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

http://q.hatena.ne.jp/1235054091の続きの質問です。
レコードセットを最初に作ります。
sql="select distinct ID * from table order by ID"
rs=openrecordset(sql)
これでrsを作りました。

続いてループでまわします。そして別のレコードセットを作ります。
Do until rs.eof
sqlnext="select * from table where ID=" & rs!ID
set rs2=nothing
rs2.openrecordset(sqlnext)

Do until rs2.eof

Excelに書き込み作業
rs2.movenext
loop

excelに保存作業
rs.movenext
loop

という回りくどいやり方でexcelへ保存作業を行っております。例えばIDが1,1,2,2,2,3,3,3とあった場合、1は1の塊で出力、2は2の塊で出力、3は3の塊で出力して保存したいと思っています。この例だと3ファイルできるはずです。3ファイルは作ることができました。しかし、1のファイルを見ると、1のIDだけをひっぱってきているので問題ない。2のファイルを見るとIDが1と2のファイルを持ってきている、×。3つ目のファイル。IDが1,2、3のIDを引っ張ってきている。ダメ。という具合に上手に塊で出力することができません。どこが悪いのでしょうか?


●質問者: akaired
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:Excel LOOP nothing SELECT SET
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● Mook
●400ポイント ベストアンサー

コードの全体が見えていないので何とも言えませんが、クエリの処理よりEXCELのデータ出力処理の

部分の問題であるような気がします。


下記は同様の処理をファイル別に出力した例ですが、こちらの試験の範囲ではデータの重複なく出力

できました。


実際の EXCEL への出力の部分を提示いただければ具体的な回答ができるかと思います。

Option Explicit

Sub dataDistributer()
 Dim wb As Workbook
  'テーブルの名前を指定
 Const tableName As String = "テーブル1"
 
 Dim res1 As DAO.Recordset
 Dim res2 As DAO.Recordset
 
 Set res1 = query("SELECT DISTINCT ID FROM " & tableName & " ORDER BY ID")

 Dim r As Long, c As Long
 Do While res1.EOF = False
 Set res2 = query("SELECT * FROM " & tableName & " WHERE ID = " & res1.Fields(0).Value)
 Set wb = Workbooks.Add()
 r = 0
 Do While res2.EOF = False
 r = r + 1
 For c = 0 To res2.Fields.Count - 1
 wb.Worksheets(1).Cells(r, c + 1).Value = res2.Fields(c).Value
 Next
 res2.MoveNext
 Loop
 wb.SaveAs ThisWorkbook.Path & "\" & res1.Fields(0).Value & ".xls"
 res1.MoveNext
 Loop
End Sub


Function query(sql As String) As DAO.Recordset
  'Accessのファイルのパスを指定
 Const mySource = "C:\Database\myDB.mdb"
 Dim db As DAO.Database
 Set db = DBEngine.Workspaces(0).OpenDatabase(mySource)
 Set query = db.OpenRecordset(sql)
 Set db = Nothing
End Function

http://www.happy2-island.com/access/gogo03/capter00207.shtml

◎質問者からの返答

ご回答ありがとうございます。excelへの書き込み作業の部分は、

Cells(row, col).Value = rs2!ID

Cells(row, col).Value = rs2!NAME

Dim x as string

x=rs2!ID

.....

とレコードセット2の値をcells関数で指定して保存しています。

続きまして、rs.movenextでrs2のレコードセットが空になったら、Pathで出力先フォルダを決めて、

filename=Path & x

wb.saveas filename

これで保存します。そして、

rs.movenextで最初の行に戻ります。具体性に欠けるかも知れませんが、よろしくお願いいたします。


2 ● Mook
●0ポイント

先の回答で言い忘れましたが、コメントを有効にしていただけると対応がしやすいです。


肝心な部分が書かれていないので何とも言えませんが、ファイルの扱いはどのようになっているでしょうか。

 Do While rs1.EOF = False
 Set rs2 = ・・・・・
  '★★★★ここに wb を新規で作成する(もしくは初期化する)処理が必要
 Do While rs2.EOF = False
 セルの書き込み処理
 row = row+1
 Loop
 filename=Path & x
 wb.saveas filename
 Loop

のような構造だと、追記して上書き処理なので質問された現象になるかと思います。


これにファイルの作成処理は先の回答で行っているのでご参考ください。

 Set wb = Workbooks.Add()

の部分です。

http://officetanaka.net/excel/vba/file/index.htm

◎質問者からの返答

わかりにくくて申し訳ありません。下記に再度書いてみました。

テーブルはanimalでフィールド名にID、カテゴリ、種類とあります。ID=1,1,2,2,3... カテゴリ犬、犬、猫、猫、鳥... 種類=マルチーズ、秋田犬、ペルシャ猫、雑種猫、フクロウ

というデータがあります。

Dim rs1 as dao.recordset, Dim rs2 as dao.recordset Dim st1 as string,Dim st2 as string dim row as int=0 Dim output as string Dim path as string

Set apx = CreateObject("Excel.Application")

Set wb = xl.Workbooks.Add

Set ws = x.Worksheets(1)

st1="select distinct ID from animal order by animal"

set rs1=openrecordset(st1,dbopendynaset)

Do until rs1.eof

st2="select ID,カテゴリ、種類 where ID='" & rs1!ID & "'"

set rs2=nothing rs2=openrecordset(st2,dbopendynaset)

Do until rs2.eof

row =row+1

cells(row,1).value=rs2!ID

cells(row,2).value=rs2!カテゴリ

cells(row,3).value=rs2!種類

dim x as string x=rs2!ID

rs2.movenext

loop

path="C:\"

output = path & x & "xls"

web.saveas output

rs1.movenext

loop

msgbox "end"

といった感じになります。

関連質問


●質問をもっと探す●



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