Ｐａｇｅ 604 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼VB〜Excelへの質問です。 KKKozi 03/1/15(水) 12:00 ┗Re:VB〜Excelへの質問です。 ichinose 03/1/15(水) 13:42 ┣Re:VB〜Excelへの質問です。 ハマゾウ 03/1/16(木) 12:17 ┃ ┗Re:VB〜Excelへの質問です。 ichinose 03/1/17(金) 1:04 ┃ ┗Re:VB〜Excelへの質問です。 こうちゃん 03/1/17(金) 11:06 ┃ ┗Re:VB〜Excelへの質問です。 ichinose 03/1/17(金) 21:56 ┃ ┗Re:VB〜Excelへの質問です。 こうちゃん 03/1/18(土) 0:55 ┃ ┗Re:VB〜Excelへの質問です。 ハマゾウ 03/1/18(土) 13:11 ┃ ┗Re:VB〜Excelへの質問です。 ichinose 03/1/18(土) 20:37 ┃ ┗Re:VB〜Excelへの質問です。 ハマゾウ 03/1/19(日) 16:03 ┃ ┗Re:VB〜Excelへの質問です。 ichinose 03/1/19(日) 17:41 ┗Re:VB〜Excelへの質問です。 KKKozi 03/1/24(金) 14:44 ─────────────────────────────────────── ■題名 ： VB〜Excelへの質問です。 ■名前 ： KKKozi ■日付 ： 03/1/15(水) 12:00 -------------------------------------------------------------------------
| VBからSQLを用いデータをRecordsetし、DBのテーブルにデータ書き込む・・のようなプログラムを作りました。 このRecordsetしたデータをDBではなく、エクセルシートに書き込みたいのですが・・・ よい方法はありませんか？ 漠然とした質問で申し訳なく思っていますが、是非よろしくお願いたします。 |
| ▼KKKozi さん： こんにちは。 >VBからSQLを用いデータをRecordsetし、DBのテーブルにデータ書き込む・・のようなプログラムを作りました。 > >このRecordsetしたデータをDBではなく、エクセルシートに書き込みたいのですが・・・ > >よい方法はありませんか？ >漠然とした質問で申し訳なく思っていますが、是非よろしくお願いたします。 私は、普段良く使ってますが、CopyFromRecordsetメソッドだと一発です。 ・ ・ rs2.Open "select * from 顧客区分 order by t_顧客区分;", cn, adOpenStatic, adLockPessimistic If rs2.EOF <> True Then range("a1").CopyFromRecordset rs2 'ＶＢからでしたら、Excelオブジェクトから指定しなければなりませんが・・ End If 詳しくは､ＨＥＬＰで・・・。 |
| ▼ichinose さん： 横から失礼します。 ご教授いただいた方法だと、256行を超えるデータを貼り付けるとシートからはみ出してしまいます。何か良い方法をご存知でしたら教えてください。 （例えば、行と列を入れ替えて貼り付ける等） |
| ▼ハマゾウ さん： こんばんは。 > >ご教授いただいた方法だと、256行を超えるデータを貼り付けるとシートからはみ出してしまいます。何か良い方法をご存知でしたら教えてください。 > フィールドが256を超えるＤＢだと一発と言うわけにはいきませんよね。 私が考えているロジックとしては､Fields(x).nameやCountを元に、256個づつフィールド名を指定したＳｑｌを作成すると言う方法ですが（うまくいくかどうかはわかりませんが）、夕方考えようと思っていたら、所要ができてしまいました。時間を下さい。 今､考えると、アルコールが入っているので絶対間違えてしまいそうです。 すみません。他の方で、もっと簡単な方法があったら、お願いします。 私の場合､レコードセットをExcel上で簡単に表示するのに､CopyFromRecordsetメソッドを使うということを意識しているので、テーブル設計の段階で256を超えるようなフィールド数のテーブルにはしません。情報として､256を超えるような場合､テーブルを分けてしまいますが・・・。 |
| みなさん、こんにちは ichinoseさん、横入りごめんなさい。 縦横変換と複数シートへの分割書き込みのテストモジュール書いてみました。 こんなんでどうでしょ？ Sub test() Dim DataConn As ADODB.Connection Dim strConn As String Dim rs As ADODB.Recordset Dim Fld As ADODB.Field Dim strSQL As String Dim i As Long Dim j As Long 'どう接続するかわからなかったので、とりあえずADOです。 'ADOへの参照設定が必要です。 'データベース接続、実際のものに変更してね。 strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\***.mdb" Set DataConn = New ADODB.Connection DataConn.ConnectionString = strConn DataConn.Open strSQL = "SELECT * FROM Q基本情報 " Set rs = New ADODB.Recordset rs.Open strSQL, DataConn, adOpenStatic If Not rs.EOF Then If rs.Fields.Count > 256 Then If rs.RecordCount < 255 Then 'フィールドが256を超えていてレコード数が255以下なら縦横変換 If MsgBox("フィールド数が256を超えています。" & vbCrLf & _ "縦横変換すれば書き込めますが、処理をつづけますか？", _ vbQuestion + vbYesNo) = vbYes Then rs.MoveFirst i = 0 For Each Fld In rs.Fields i = i + 1 Cells(i, 1) = Fld.Name Next j = 1 Do While Not rs.EOF j = j + 1 i = 0 For Each Fld In rs.Fields i = i + 1 Cells(i, j) = Fld.Value Next rs.MoveNext Loop Else Exit Sub End If Else 'フィールドが256を超えていてレコード数が255以上なら複数シートに分割書込み If MsgBox("フィールドが256を超えています。" & vbCrLf & _ "複数シートにまたがって出力しますか？", _ vbQuestion + vbYesNo) = vbYes Then rs.MoveFirst i = 0 For Each Fld In rs.Fields i = i + 1 Sheets(((i - 1) \ 256) + 1).Cells(1, ((i - 1) Mod 256 + 1)) = _ Fld.Name Next j = 1 Do While Not rs.EOF j = j + 1 i = 0 For Each Fld In rs.Fields i = i + 1 Sheets(((i - 1) \ 256) + 1).Cells(j, ((i - 1) Mod 256 + 1)) = _ Fld.Value Next rs.MoveNext Loop Else Exit Sub End If End If Else '256を超えなければこれが早いですね。 Range("A1").CopyFromRecordset rs '#256で切り捨てなら第3引数に最大列数指定すればいいけどね 'Range("A1").CopyFromRecordset rs,,256 End If End If End Sub #ちょっと冗長ですね^^; |
| ▼こうちゃん さん、フォローありがとうございます。 私も今考えようと思ってたんですが･･･。 ところで、質問よろしいですか？ サンプルテーブルを作ろうと思ってたんですが､256を超えるフィールドのテーブルが作れないんです。 （こんなに多いフィールド作った事ないんで調べた事なかったんですが・・・） excelから、Adoで・・、 Public cn As New ADODB.Connection Public rs As New ADODB.Recordset '============================ Sub create_tbl() Call open_db("大きなテーブル.mdb") Dim data_str(1 To 255) For i = 1 To 255 ' ↑255まで作れますが・・・、 data_str(i) = "a" & i & " integer" Next a = Join(data_str(), ",") cn.Execute "CREATE TABLE 大きなテーブル (" & a & ");" close_db End Sub '==================================================== Sub open_db(dbnm As String) On Error GoTo err_open_db Dim fldnm As String foldnm = ThisWorkbook.Path & "\" cn.ConnectionString = "provider=Microsoft.jet.OLEDB.4.0;" & "Data Source=" & foldnm & dbnm cn.Open On Error GoTo 0 Exit Sub err_open_db: MsgBox Error(Err.Number) & Err.Number Stop End Sub '============================================================== Sub close_db() On Error Resume Next cn.Close On Error GoTo 0 End Sub この方法で２５５までは､可能ですが､それ以上作れるんですか？フィールド・・mdbファイルで・・・。 |
| ichinoseさん、こんばんは >この方法で２５５までは､可能ですが､それ以上作れるんですか？フィールド・・mdbファイルで・・・。 つくれません。^^; Accessの質問箱で、以前Accessの仕様についてお答えした時の記憶がよみがえりました（爆） 今回は例題で、もし255以上のフィールドがあった場合でも縦横変換や、複数シートで対応できる、ってことをお示ししたんです。 とか言ってみたりして・・・^^; まあ、たとえばオラクル等で256を超えるテーブルではODBC等で接続して、こんな感じでやればいいんじゃないでしょか、ってとこですね。レコードセットの分割出力のみに考えが飛んじゃってました。 ＃試験は20位のフィールドのテーブルで、条件を10フィールドとかでしちゃいましたんで、256まで思い至りませんでした。 配慮が足らなかったことをお詫び申し上げます。m(__)m ＃PS:いつもここを見てichinoseさんの回答に感心しておりました。ファンです！！ |
| ▼ichinoseさん、こうちゃんさん： 縦横変換の方法や複数シートに貼り付ける方法、とても参考になりました。 ありがとうございました。 |
| ハマゾウさん、こうちゃん、こんばんは。 こうちゃん。 >つくれません。^^; そうですか。安心しました。コードも参考になります。ありがとうございます。 ハマゾウさん。 遅くなりました。 私もOracleの環境がないので、mdbでですが、仕様としては､レコードセットを分けると言う事です。例では､１０フィールドづつ別のシートに貼り付けています。 ただし、事前に必要シートは用意してあるものとします。 '================================= Public cn As New ADODB.Connection '==================================== Sub test() Dim sql_str As String Dim f_cnt As Long Dim rs1 As ADODB.Recordset Dim rs2 As ADODB.Recordset Dim fld_nm() As String Call open_db("大きなテーブル.mdb") 'データベースオープン Set rs1 = New ADODB.Recordset Set rs2 = New ADODB.Recordset sql_str = "select * from テーブル1;" if open_rs(sql_str, rs1)=0 then ' 一旦、フィールド名を取得するためにレコードセットを開く ans = get_fld_nm(fld_nm(), rs1, 10) ' 10列分のフィールド名取得 idx = 1 Do While ans = 0 sql_str = "select " & Join(fld_nm(), ",") & " from テーブル1;" ' sql編集 Call open_rs(sql_str, rs2) ' 新たにレコードセット取得 Worksheets(idx).Range("a1").CopyFromRecordset rs2 ' 例のメソッド Call close_rs(rs2) Erase fld_nm idx = idx + 1 ans = get_fld_nm(fld_nm(), rs1) ' 次の１０フィールド名を取得 Loop Call close_rs(rs1) end if Call close_db End Sub '================================================================ Sub open_db(dbnm As String) 'データベースオープン（コネクションの接続） On Error GoTo err_open_db Dim fldnm As String foldnm = ThisWorkbook.Path & "\" cn.ConnectionString = "provider=Microsoft.jet.OLEDB.4.0;" & "Data Source=" & foldnm & dbnm cn.Open On Error GoTo 0 Exit Sub err_open_db: MsgBox Error(Err.Number) & Err.Number Stop End Sub '========================================================== Sub close_db() 'データベースのクローズ On Error Resume Next cn.Close On Error GoTo 0 End Sub '================================================================ Function open_rs(sql_str As String, rs As ADODB.Recordset) As Long 'レコードセットのオープン ' input : sql_str - ＳＱＬ文字列 ' output ： rs オープンされたレコードセット ' open_rs 0-正しく取得 ' その他 エラーＯＲ ﾃﾞｰﾀなし On Error Resume Next open_rs = 0 rs.Open sql_str, cn, adOpenStatic, adLockOptimistic If Err.Number <> 0 Then open_rs = Err.Number End If If rs.EOF = True Then open_rs = 1 End If On Error GoTo 0 End Function '============================================================== Function get_fld_nm(get_flnm() As String, rs As ADODB.Recordset, Optional lim As Long = 0) '指定された個数分づつフィールド名を取得する ' input lim - 一回に取り出すフィールド数を指定（省略可) ' rs - 元になるレコードセット（既にオープンされた状態のもの） ' output get_flnm() -フィールド名 On Error Resume Next Static sv_lim As Long Static s_idx As Long Dim array_idx As Long If lim <> 0 Then sv_lim = lim s_idx = 0 End If If s_idx >= rs.Fields.Count Then get_fld_nm = 1 Exit Function End If array_idx = 0 For idx = s_idx To s_idx + sv_lim - 1 If idx >= rs.Fields.Count Then Exit For End If ReDim Preserve get_flnm(array_idx) get_flnm(array_idx) = rs.Fields(idx).Name array_idx = array_idx + 1 Next idx s_idx = s_idx + sv_lim get_fld_nm = 0 End Function というようにしました。 |
| ▼ichinose さん： ご回答、どうもありがとうございます。 理解するのに時間がかかり、お礼が遅くなりました。 例のメソッド(CopyFromRecordset)を使って貼り付ける回数を 減らすことで処理が速くなるのですね。 ＜追伸＞ "Call close_rs(rs2)"の箇所でエラーが発生しましたので、 以下のコードを追加しました。 Sub close_rs(rs3 As ADODB.Recordset) rs3.Close End Sub |
| ▼ハマゾウ さん： こんばんは >"Call close_rs(rs2)"の箇所でエラーが発生しましたので、 >以下のコードを追加しました。 >Sub close_rs(rs3 As ADODB.Recordset) on error resume next > rs3.Close on error goto 0 >End Sub すみません。記述し忘れました・・・。 エラートラップを入れて追加しといてください。 |
| ▼ichinose さん： >▼KKKozi さん： >こんにちは。 >>VBからSQLを用いデータをRecordsetし、DBのテーブルにデータ書き込む・・のようなプログラムを作りました。 >> >>このRecordsetしたデータをDBではなく、エクセルシートに書き込みたいのですが・・・ >> >>よい方法はありませんか？ >>漠然とした質問で申し訳なく思っていますが、是非よろしくお願いたします。 >私は、普段良く使ってますが、CopyFromRecordsetメソッドだと一発です。 > ・ > ・ >rs2.Open "select * from 顧客区分 order by t_顧客区分;", cn, adOpenStatic, adLockPessimistic >If rs2.EOF <> True Then > range("a1").CopyFromRecordset rs2 >'ＶＢからでしたら、Excelオブジェクトから指定しなければなりませんが・・ > End If >詳しくは､ＨＥＬＰで・・・。 ありがとうございます。 さっそくですが試してみました！ 返事が大変遅くなりすみません。 |