• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:EXCELマクロの処理時間を短縮したい)

EXCELマクロの処理時間を短縮したい

このQ&Aのポイント
  • Windows XP ProとEXCEL 2002を使用している状況で、EXCELマクロの処理時間が長くなって困っています。具体的な作業内容はOLEDBを使って他のDBからデータを展開し、そのデータを一覧に整理するというものです。処理に時間がかかる要因は、シートAのデータ件数が約4万件であり、シートMのデータ件数も約3万件あるためです。これらの処理をより効率的に実行する方法を教えてください。
  • マクロのソースコードでは、収集したデータをシートAとシートMに展開しています。シートAのデータは番号、コード、数量、単価、追加数量、追加単価の情報を持っています。シートMのデータはコードと名称の情報を持っています。これらのデータを基本番号別に整理し、金額を計算してシート一覧に表示するという処理です。
  • 具体的なマクロソースコードは、シートAのデータを一時的に読み込み、基本番号と枝番を考慮して一覧にコピーしている部分と、シートMのデータを基本番号に紐づけて名称を一覧に入力している部分です。マクロソースコードによる処理時間の短縮が望まれます。

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

  • ベストアンサー
  • end-u
  • ベストアンサー率79% (496/625)
回答No.2

>Do While jdata.Cells(i, 1).Value < 9500000 >  read_no = jdata.Cells(i, 1).Value / 10 >  j = 0 >  If jdata.Cells(i, 2).Value <> 0 Then  '枝番有 >    j = judata.Cells(i, 2) >  End If >  i = i + j >  jlist.Cells(k, 1).Value = Format(read_no, "000000") >  jlist.Cells(k, 2).Value = jdata.Cells(i, 3).Value >  jlist.Cells(k, 4).Value = jdata.Cells(i, 4).Value >  jlist.Cells(k, 5).Value = jdata.Cells(i, 5).Value >  jlist.Cells(k, 6).Value = jdata.Cells(i, 6).Value >  jlist.Cells(k, 7).Value = jdata.Cells(i, 7).Value >  jlist.Cells(k, 8).Value = _ >  Application.RoundDown((jdata.Cells(i, 4).Value * jdata.Cells(i, 5).Value + _ >              jdata.Cells(i, 6).Value * jdata.Cells(i, 7).Value), 0) >  k = k + 1 >  i = i + 1 >Loop この箇所、1セルずつ書き込んでいますから遅いです。 Sheets("A")のデータを配列に取り込んで、同行8列の配列を作って処理し、 Sheets("一覧")に一括で書き込むようにしたほうが速くなります。 具体的には >'i = 2    '今読んでる行 >'k = 2    '書いている行 >'j = 0    '枝番が合った場合 飛ばす行 >'read_no = 0 以上は不要。 : With jdata   'Sheets("A")のA列最下行からG2セルまでのデータ部を配列に   v = .Range("G2", .Cells(.Rows.Count, 1).End(xlUp)).Value End With 'vと同サイズ(列は8)の空配列準備 ReDim w(1 To UBound(v), 1 To 8) '書き込み位置 k = 0 '配列1次元の要素の数だけLoop For i = 1 To UBound(v)   '一応、Loop終了条件踏襲   If v(i, 1) >= 9500000 Then     Exit For   End If   read_no = v(i, 1) / 10   If v(i, 2) <> 0 Then '枝番有     i = i + v(i, 2)   End If   k = k + 1   w(k, 1) = Format(read_no, "000000")   w(k, 2) = v(i, 3)   w(k, 4) = v(i, 4)   w(k, 5) = v(i, 5)   w(k, 6) = v(i, 6)   w(k, 7) = v(i, 7)   w(k, 8) = Application.RoundDown((v(i, 4) * v(i, 5) + _                    v(i, 6) * v(i, 7)), 0) Next 'kがwの書き込み数なのでSheets("一覧")の範囲をResizeして書き込み jlist.Range("A2:H2").Resize(k).Value = w : こんな感じです。 もしかしたらRoundDown計算は一度Sheets("A")のH列でやってから 配列に一緒に取り込むようにしたほうが速いかもしれません。 また、dictionaryを使った名称セットも 上記Loopの中でやってしまっても良いかもしれませんね。

ishi_rin
質問者

お礼

ありがとうございます。 おかげ様で2.の処理があっという間に終わるようになりました。 No.3で頂いた回答と合せて 5分近く掛かっていた処理が30秒掛からず終了するようになりました。 回答して頂いた皆様に感謝いたします。

その他の回答 (3)

  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.4

3の所だけ試験データを作成してやってみました。xl2000,WindowsXP SP3,PentiumM 1.3Gの古いマシンです。 ご提示のコードより単純な方法で、同等の事をしているつもりですが、数秒で終了しました。ご参考まで。 Sub test3() Dim myDic As Object Dim i As Long Dim targetRange As Range Dim buf As Variant Application.ScreenUpdating = False Set myDic = CreateObject("scripting.dictionary") Set targetRange = Sheets("M").Range("A2:B30001") buf = targetRange For i = LBound(buf, 1) To UBound(buf, 1) myDic.Add buf(i, 1), buf(i, 2) Next i Set targetRange = Sheets("一覧").Range("A2:H35001") buf = targetRange For i = LBound(buf, 1) To UBound(buf, 1) If myDic.exists(buf(i, 2)) Then buf(i, 3) = myDic(buf(i, 2)) Else buf(i, 3) = "無" End If Next i targetRange = buf Application.ScreenUpdating = True End Sub

ishi_rin
質問者

お礼

ありがとうございます。 皆様にお教え頂いた結果 時間短縮に成功いたしました。

  • end-u
  • ベストアンサー率79% (496/625)
回答No.3

>..3.のところで2分以上.. 処理3はdictionaryと配列を使ってるのにそんなにかかりますか。 ひょっとしたら別の原因で遅くなってるのかも。 ScreenUpdatingプロパティだけではなく、 (処理前) Dim x As Long With Application   x = .Calculation   .Calculation = xlCalculationManual   .EnableEvents = False   .ScreenUpdating = False End With : (処理後) With Application   .Calculation = x   .EnableEvents = True   .ScreenUpdating = True End With のように、イベントと再計算の制御もやったほうが良いかもしれません。 それに処理3を弄るとしたら : Set jname = Worksheets("M") With jname   With .Range("B2", .Cells(.Rows.Count, 1).End(xlUp))     v = .Columns(1).Value     w = .Columns(2).Value   End With End With Set dic = CreateObject("scripting.dictionary") For i = 1 To UBound(v)   dic(CStr(v(i, 1))) = i Next With jlist   With .Range("B2", .Cells(.Rows.Count, 2).End(xlUp))     v = .Value     ReDim z(1 To UBound(v), 0) As String     For i = 1 To UBound(v)       j = dic(CStr(v(i, 1)))       If j = 0 Then         z(i, 0) = "無"       Else         z(i, 0) = w(j, 1)       End If     Next     .Offset(, 1).Value = z   End With End With こんな感じでしょうか。

ishi_rin
質問者

お礼

ありがとうございます。 おかげ様で 3.の処理が10秒程度で終わるようになりました。

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

望む回答ではないだろうが、 (1)2つのエクセルシートに、OLEDBを使って他のDBから、 トランザクション「A」のデータを シート「A」に マスタ「M」のデータを シート「M」に展開して、処理はせずに時間を計る(プログラムを加える)。 シートデータを一旦保存。 (2)次に(データベースのデータは使わず・読まず)両シートだけを読んで処理するプログラムに(改変は一部で済むと思うが)変える。 (処理時間を計るプログラムを加える) (2)では現状より相当短縮されるなら、OLEDBを使って他のDBから、エクセルシートへが要因ではないか。 原因追求には、どんなことでも、こういう切り分けが必要だろう。 2重ループもないようだし、コードだけから割り出すのは難しいのでは。 木になるのはFSOのDictionaryという素人受けの仕組みを使っているようなこと。 すばらしい仕組みだが時間はかかるのではないかな。 ソート法でソートし、マッチングアルゴリズムを使えば速くなると思うが、やっている内容がよくわからないので何ともいえない。 === 別のことだが、全体的に何がしたいのか、質問文章で表現できないのか。 質問にはSet jlist = Worksheets("一覧")'処理2からjlist.Range("H1").Value = "金額"までなど1回限りのことで書く必要は無いだろう。 前半は1歩1歩書いてあるようでいて、その後は単純な順処理なのか、マッチング的なことなのか何がしたいのか、判りにくい。 データは再現できないし、テストも出来ない。 もっと読者・回答者のことを慮って、質問の表現・内容を考えててほしい。コードを丸写しでなく、処理内容の解説がほしい。この質問を見たらパスする人が多いのでは。

ishi_rin
質問者

お礼

ありがとうございます。 文章が判りにくく申し訳ありません。ご親切な皆様に助けていただいています。

関連するQ&A

専門家に質問してみよう