データベースからエクセルのシートに素早く転記する方法

このQ&Aのポイント
  • オラクルのデータベースから呼び出して、エクセルのシートに素早く転記する方法を教えてください。
  • 現在は1項目ずつ転記しているため、1000行で1分かかっています。
  • 配列を使用するなど、より効率的な方法があれば教えていただけますか?
回答を見る
  • ベストアンサー

データベースから呼び出して、エクセルのシートに素早く転記したい。

データベースから呼び出して、エクセルのシートに素早く転記したい。 オラクルのデータベースから呼び出して、エクセルのシートに転記しているのですが、 1項目ずつなので、1000行で1分くらい掛かります。 配列が良いと聞きますが、さっぱり分かりません。 何か良い方法があれば、御教授願えませんでしょうか? If (OraDset.EOF = False) Then Do Until (OraDset.EOF) Line_Cnt = Line_Cnt + 1 Range("C" & Line_Cnt).Value = OraDset.Fields("BBB").Value Range("D" & Line_Cnt).Value = OraDset.Fields("CCC").Value Range("E" & Line_Cnt).Value = OraDset.Fields("DDD").Value Range("F" & Line_Cnt).Value = OraDset.Fields("EEE").Value Range("G" & Line_Cnt).Value = OraDset.Fields("FFF").Value OraDset.MoveNext DoEvents Loop End If

質問者が選んだベストアンサー

  • ベストアンサー
回答No.3

特に何もデータ弄ってなく、かつ固まってるみたいだから CopyFromRecordsetでいいんじゃないですか? というか1分ってえらい時間かかってますね。

TAITAN777
質問者

お礼

会話になっていなくて済みません。 もしかして、途中に一行、 ActiveSheet.Range("b12").CopyFromRecordset Rs こんな感じで入れれば良いのでしょうか?

TAITAN777
質問者

補足

素早い返事ありがとうございます。 ただ私自身はエクセルのマクロしか分からなくて、このソースも 他の方に作ってもらったものです。データベースへのアクセスへの 部分は特に分からないので、OraDset.Fieldsで呼び出してから、 書き込みを一気にできないかな、という感じです。 1項目ずつ書き込んでいくのは、こんなものなんでしょうか? Public pOraSession As OraSession Public pOraDB As OraDatabase Public Line_Cnt As Long Public strEigcod As String Sub Ten_Data() Dim strDbname As String Dim strUser As String Dim strPath As String Dim OraDset As OraDynaset Dim strSql As String strDbname = "AAAA" strUser = "AA" strPath = "AA" Set pOraSession = CreateObject("OracleInProcServer.XoraSession") Set pOraDB = pOraSession.dbopendatabase(strDbname, strUser & "/" & strPath, 0&) Range("F2").Select strEigcod = ActiveCell.Value If (strEigcod = "1") Then strEigcod = "111" Else strEigcod = "222" End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Line_Cnt = 11 strSql = "select * from Tenjdb where Jyokub = '0' and Eigcod = '" & strEigcod & "' " & _ "order by Torcod,Tencod,Kanrno" Set OraDset = pOraDB.DbCreateDynaset(strSql, 0&) (最初に投稿した部分) Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.Calculate Range("A2").Select Set OraDset = Nothing Set pOraDB = Nothing Set pOraSession = Nothing End Sub

その他の回答 (3)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.4

別方法で早くなるかどうかに関心があるなら http://www.atmarkit.co.jp/fdb/rensai/excel2oracle02/excel2oracle02_1.html にあるオラクルからデータをエクセルに持ってくる方法がエクセルのメニューにありますので、やってみるか、ということです。 Microsoft Queryを使用、に当たるものでデーター外部データの取り込みの操作です。 上記WEBの Microsoft Queryを使用する方法をよく読んで、やれるかどうかやってみてください。 こちらはテストできる環境になく(オラクルを使ってない)ので、詳細を記すことは出来ませんが、Accessなどの例では簡単なので、大雑把に言えば、指定を変えるだけと思いますが、相当経験はいるかもしれません。 詳しい人が近くにいるようなので、WEBの方法の設定などで、アドバイスを受けるか、このOKWAVEのオラクルのカテゴリに質問を出して見るのはどうかな。特殊なほう(オラクル)に質問を出すのが、質問のコツですよ。

  • sppla
  • ベストアンサー率51% (185/360)
回答No.2

画面に表示しているシートに対して書き込みを行っている場合には、画面の描画時間もかかります。その場合には他のシートを表示しておき、データを書き込むシートを画面表示しないと速くなるかもしれません。

TAITAN777
質問者

補足

ありがとうございます。 下記のような事を、試してみました。 少し早くなりました。 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.Calculate

  • webuser
  • ベストアンサー率33% (372/1120)
回答No.1

viewで加工して最終形を作っておき、それをODBCなどから呼び出すのはどうですか?

関連するQ&A

  • excel ユーザーフォームでシートごとに転記2

    先日ユーザーフォームへの転記について質問させていただきました。 ご回答いただき、ありがとうございました。 今度はオプションボタンで選択したときに、シートごとに転記する方法を 教えていただけますでしょうか。 ユーザフォーム上で、オプションボタンを選択。 OptionButton1・・・シート1へ転記 OptionButton2・・・シート2へ転記 これをOKボタンを押したときに転記するようにしたいと思っています。 Private Sub OK_Click() Dim CLrow As Long Dim KYrow As Long CLrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row KYrow = Worksheets("Sheet2").Range("A65536").End(xlUp).Row If OptionButton1.Value = True Then Worksheets("Sheet1").Range("A" & CLrow).Value = .TextBox1.Value ElseIf OptionButton2.Value = True Then Worksheets("Sheet2").Range("A" & KYrow).Value = .TextBox1.Value End With End Sub ここまでやってみたのですが「参照が不正または不完全です」 と出てしまいます。 どなたかご教示願います。 よろしくお願いします。

  • VBA シート上の転記について

    If 入力シート.Range("A4").Value = "会社" Then Dim 会社シート最終行 As Long 会社シート最終行 = 会社シート.Range("AA65536").End(xlUp).Row + 1 会社シート.Range("A" & 会社シート最終行).Value = 入力シート.Range("A4").Value 会社シート.Range("A" & 会社シート最終行).Value = 入力シート.Range("B4").Value VBAで上記のように入力していて、これに会社シートのA行を別のシートに転記したい場合どういう入力方法になるのでしょうか。 同じ公式で会社シートの所をsheet1、入力シートの所を会社シートと入力したのですがまったく反映されませんでした。 VBAを始めたばかりなので試行錯誤しながらしています。

  • EXCEL VBA 転記 条件分岐 新規転記 上書転記 プログラム

    いつも御世話になっております。 以下のことをしたいのですが、詰まってしまいました。 皆様の力をお借りしたいと思い、書き込ませていただきます。 ・ボタン1をクリックすると、base(転記元)のG列に書かれた事項と同一のシート(転記先)へ転記する(各シートA,B,Cへ転記) ・転記先のE列を見て、既存のものであれば、上書きする ・転記先のE列を見て、新規のものであれば、空いている行を探し転記する。 (例) base(転記元シート) E1|F1|G1 名前 収入 シート先 月曜 50 A 火曜 100 A 木曜 150 C 土曜 50 A 日曜 100 B 水曜 150 A 金曜 10 C 転記実行前 A(転記先シート) E1|F1|G1 名前 収入 シート先 月曜 A 火曜 A 土曜 A 転記実行後 A(転記先シート) E1|F1|G1 名前 収入 シート先 月曜 50 A 火曜 100 A 土曜 50 A 水曜 150 A 以下に作成したプログラムを記述します。 が、IF文に関するエラーが生じております。 Sub ボタン1_Click() Dim dstSheet As Worksheet Dim srcRow As Long Dim dstRow As Long Dim name As Integer Dim obj As Object Set srcSheet = Sheets("base") For srcRow = 2 To srcSheet.Range("G" & Rows.Count).End(xlUp).Row '元シートのデータ範囲で繰り返し(シート先は必須なのでG列でチェック) If srcSheet.Range("G" & srcRow).Value <> "" Then '(転記先シート名)が空白でない場合に実行(1) Set dstSheet = Sheets(srcSheet.Range("G" & srcRow).Value) 'シート取得(1) name = Sheets(srcSheet.Range("E" & srcRow).Value) '名前を取得(1) Set obj = Worksheets(dstSheet).Cells.Find(name) '名前を転記先の中で検索(1) End If '(1)の終了 If obj Is Nothing Then '検索でかからなかったら、新たに空白の行を見つけて転記元から転記先へ転記する(3) '以下3行問題点???? dstRow = dstSheet.Range("G" & Rows.Count).End(xlUp).Row + 1 '転記先行取得 If dstSheet.Range("E2") = "" Then dstRow = 1 '質問で転記先には1行目からなので、それに対応 dstSheet.Range("E" & dstRow).Resize(1, 3).Value = srcSheet.Range("E" & srcRow).Resize(1, 3).Value 'データ転記 End If Else '検索でかかったら、該当の行のアドレスを割り出し、特定の範囲を上書きする。(4) lngYLine = obj.Row intXLine = obj.Column With Sheets(dstSheet) '検索でかかったら、該当の行のアドレスを割り出し、特定の範囲を上書きする。(4) dstSheet.Range("E" & lngYLine).Resize(1, 3).Value = srcSheet.Range("E" & srcRow).Resize(1, 3).Value 'データ転記(4) End If '(3),(4)の終了 Set obj = Nothing 'Objの初期化 Next End Sub

  • 転記の仕方

    Sub 入力する() If AIRシート.Range("A1").Value = "A" Then Dim AIRシート最終行 As Long AIRシート最終行 = AIRシート.Range("A65536").End(xlUp).Row + 1 If AIRシート最終行 = 30 Then MsgBox "AIRシートがいっぱいです " Exit Sub Else End If AIRシート.Range("A" & AIRシート最終行).Value = 入力シート.Range("A1").Value AIRシート.Range("B" & AIRシート最終行).Value = 入力シート.Range("B1").Value MsgBox "入力完了" Else End If End Sub ●質問● 今、"入力シート"のA1に『A』と入力しマクロを実行すると"AIRシート"のA列、B列に入力シートのA1、B1の値が次々と転記されるようにしてるのですが、これを入力シートのA1だけではなく、A1~A3まで入力することが出来、実行すると全てが転記できるようにしたいのですが。 ※A2,A3は入力しないときもあります。 If AIRシート.Range("A1").Value = "A" Then           ↓          ("A1:A3") みたいな感じでです。

  • エクセルで連続しない範囲のデータ転記

    下記の Sub 転記TEST01() は正しく転記されます。 ただ、これでは何行にもなるので Sub 転記TEST02() のようにまとめてみました。ところが Sheet1のE37以下が#N/Aとなってしまいます。もちろん転記元のデータは#N/Aではなく数値です。なぜこうなるのでしょうか? Sub 転記TEST01() Set ws = ThisWorkbook.Sheets("TEST") With ThisWorkbook.Sheets("Sheet1") .Range("E4:E12").Value = ws.Range("AK4:AK12").Value .Range("E14:E15").Value = ws.Range("AK14:AK15").Value .Range("E20:E23").Value = ws.Range("AK20:AK23").Value .Range("E26").Value = ws.Range("AK26").Value .Range("E28:E50").Value = ws.Range("AK28:AK50").Value End With End Sub Sub 転記TEST02() Set ws = ThisWorkbook.Sheets("TEST") With ThisWorkbook.Sheets("Sheet1") .Range("E4:E12,E14:E15,E20:E23,E26,E28:E50").Value = _ ws.Range("AK4:AK12,AK14:AK15,AK20:AK23,AK26,AK28:AK50").Value End With End Sub

  • Excel ユーザーフォームの入力値をシートに転記

    Excelでユーザーフォームを作りました。 ユーザーフォームには、テキストボックスを2個、ボタンを1個("記入"という文字が入っています)置いてあります。 テキストボックスに入れた数値をSheet1のセル"C24","C25"に転記したいので、ユーザーフォームのコードを次のようにしましたが、エラーメッセージは出ないかわりに何も動いてくれません。 「どこ」と「なに」が違いどうするのが正しいのか教えて下さい。よろしくお願いします。 Private Sub Tbox1_Change() a = Tbox1.Value End Sub ---------------------------- Private Sub Tbox2_Change() b = Tbox2.Value End Sub ---------------------------- Sub 記入Button_Click() '入力値をSheet1に転記 Dim a As Range Dim b As Range Sheets("Sheet1").Select Set a = Range("C24") Set b = Range("C25") End Sub

  • エクセルVBAの転記について

    エクセル2013VBAで最終行を取得しての転記が上手くいきません。どのようにすれば良いかご教授ください。 簡単なサンプルを下記します。 Sub サンプル入力からのDBへの転記() Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim myRow As Long Set Sh1 = Worksheets("サンプル入力") Set Sh2 = Worksheets("サンプルDB") With Sh2 myRow = Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & myRow).Value = Sh1.Range("D4").Value .Range("B" & myRow).Value = Sh1.Range("F4").Value End With End Sub 入力内容を変えないテストでは (1)実行するとDBへの転記は問題なく出来ます。 (2)継続してマクロを実行しても問題なく転記が行われ、同じデータが蓄積されていきます。 入力内容を変更して引き続きマクロを実行すると挙動不審に陥ります。 現象としては (1)初めの行に何度も重ねて転記を行う。 (2)空白行を作り、その行に何度も転記を行ってしまう。 (3)空白行を作り、それ以降転記を実行し蓄積を行ってしまう。 入力シートには結合セル、リストを使用していますが、原因究明を行う中でこれが原因とは思えませんでした。 これがクリアできないと先に進めません。ぜひお力を貸してください。 宜しくお願い申し上げます。

  • 【VBA】 超初心者です 複数のシートに転記したい

    Sub べんきょう() Worksheets(Array(1, 3)).Select Range("A1").value = 20 End Sub もしくは Sub べんきょう() Worksheets("sheet1").Select Worksheets("sheet3").Select False Range("A1").value = 20 End Sub でやってもsheet1にしか転記されないんです!! ご指導よろしくお願いします!

  • ExcelVBAの転記(1つのひな形へ複数シート)

    お世話になります。ExcelVBAを少し学んだ程度の者です。 1つのExcelファイルに複数存在する個別のシートから、1つのひな形シートへ転記する方法に頭を悩ませております。イメージとしては名簿管理のようなものとご理解してください。 複数存在するシート(約200シート)には、項目名に対するデータ(例えば、名前や住所などが定められたセルに入力されています)が揃っておりますが、書式の変更によりひな形のシートへ転記する必要があります。 200ほどのシートには、M10セルには名前が、B15セルには住所、C16セルには電話番号が……という具合に入力されています。これらのデータをひな形シートでは、N5セルに名前、C13セルに住所、D14セルには電話番号などを転記する必要があります(セル番地は適当です)。 ひな形シートは1枚で、マクロを実行する際にひな形シートをコピーして(Xとします)、200ほどの個別のシート(A、B、C……)を転記しようと思っております。A、B、C……に入力された複数の値は項目別にCells(i,j).Valueを、XへCells(x,y).Valueへ転記すれば良いと考えておりましたが、上手くいきません。ひな形をコピーしたXのシートへ上手く転記ができず、Aを転記したシートばかりが量産され、B、C以降のシートへ制御が移っていないようです。恐らく、Workwsheetオブジェクトのカウンタ変数に問題があると思われます。 VBAのコードとしては下記のように記述しております。 Sub SheetCopy() Application.ScreenUpdating = False Dim cnt As Long 'シート数カウント変数 Dim i As Long 'シート用のカウンタ変数 Dim wb As Workbook 'コピー元 Dim ws1 As Worksheet 'コピー元 Dim ws2 As Worksheet 'コピー先 '1がコピー元で2がコピー先 cnt = Worksheets.Count 'シート数をカウント i = 2 Set wb = Workbooks("転記用.xlsm") Set ws1 = wb.Worksheets(i) Set ws2 = wb.Worksheets("ひな形") For i = 1 To cnt ws2.Copy after:=Worksheets(i) Set ws2 = wb.Worksheets(i) ws2.Cells(2, 2).Value = ws1.Cells(2, 13).Value '名前 ws2.Cells(3, 2).Value = ws1.Cells(6, 10).Value '住所 以下、同様の転記処理を記述しています。 Next i End Sub 上記のコードを、パッと見たところ、コピーはしているものの、転記先がコピー元になっているのも原因だと思います(コピー先へ転記する方法が現時点でわかりかねます……ここがネックだと考えております)。 ご知見のある方々から、アドバイスをいただけると幸いです。 どうぞ、よろしくお願い申し上げます。

  • Excel転記

    Sheet1 9行目のようにC列に(株)三井住友銀行と入力すれば、 Sheet2に転記するにはどのようにすればよいでしょうか? Excelの勉強をし始めて数ヶ月、簡単な関数はできるようになりました。 ここで皆さんに助けていただいて、マクロも少し理解できる様になりましたが、今回は途方にくれています。IF関数だけでは無理ですね…。 質問がうまくないかもしれません、その際はいろいろ聞いてください。 よろしくお願いします。

専門家に質問してみよう