[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『動作が異常に遅い』(ブラウン)
VBAについて質問です。
現在このようなマクロを組んでいるのですが、動作が異常に遅いです。
データ量は5万行ほどあるのである程度遅くなることは分かっていたのですが、1〜2時間待っても処理が終わりませんでした。
動作を早くする方法はございませんでしょうか?
もしくは当方の書き方に誤りがございますでしょうか?
Sub test()
Dim i As Long
Dim j As Long
Dim wb1 As Workbook
Dim wb2 As Workbook
Application.ScreenUpdating = False
Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\sample.csv")
Set wb2 = ThisWorkbook
For i = 2 To wb2.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
For j = 4 To wb1.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
If wb1.Worksheets("Sheet1").Cells(j, "A").Value = wb2.Worksheets("Sheet1").Cells(i, "A").Value Then
wb1.Worksheets("Sheet1").Cells(j, "H").Value = wb2.Worksheets("Sheet1").Cells(i, "B").Value
End If
Next j
Next i
Workbooks("sample.csv").Close savechanges:=True
Application.ScreenUpdating = True
End Sub
< 使用 Excel:unknown、使用 OS:unknown >
>Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\sample.csv")
これだけで、どのくらい時間がかかりますか? これが遅いようだったら、 sample.csvをsample.txtに変えてやってみる。 他は見てません。 (BJ) 2018/03/13(火) 13:00
こういうループして検索する場合、
「見つかった」ら、その後はループしなくてもいいはすですよね?
なので、
見つかったら、Exit For
として、ループを抜けるほうがループの回数を抑えられ効率的です。
特に何万回もループをする場合、どうやってループを少なくするかは考えるべきでしょう。
Sub test()
Dim i As Long Dim j As Long Dim wb1 As Workbook Dim wb2 As Workbook Application.ScreenUpdating = False Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\sample.csv") Set wb2 = ThisWorkbook For i = 2 To wb2.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row For j = 4 To wb1.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row If wb1.Worksheets("Sheet1").Cells(j, "A").Value = wb2.Worksheets("Sheet1").Cells(i, "A").Value Then wb1.Worksheets("Sheet1").Cells(j, "H").Value = wb2.Worksheets("Sheet1").Cells(i, "B").Value Exit For End If Next j Next i Workbooks("sample.csv").Close savechanges:=True Application.ScreenUpdating = True End Sub
次に、
セルから値を読んだり、セルに値を書き込んだりする処理も、
何万回もするとすごく遅くなります。なので、セルにアクセスする回数も出来るだけ押さえましょう。
こういう場合は、Variant型の変数にセルの値を一気に代入できるので、
そちらを使うとセルへのアクセスを最小限にできますのでかなりの高速化が期待できます。
Sub test2()
Dim i As Long Dim j As Long Dim wb1 As Workbook Dim wb2 As Workbook Dim v As Variant Dim vv As Variant
Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\sample.csv") Set wb2 = ThisWorkbook
v = ThisWorkbook.Worksheet("Sheet1").UsedRange.Value With wb1.Sheets(1).UsedRange vv = Intersect(.Cells, .Offset(3)).Resize(, 8).Value End With
For i = 1 To UBound(v, 1) For j = 1 To UBound(vv, 1) If vv(j, 1) = v(i, 1) Then vv(j, 8) = v(i, 2) Exit For End If Next j Next
With wb1.Sheets(1).UsedRange Intersect(.Cells, .Offset(3)).Resize(, 8).Value = vv End With
Workbooks("sample.csv").Close savechanges:=True End Sub
次に、
VBAは実行時に1行1行パソコンの解る言葉に翻訳して実行されるので、
既に翻訳されているエクセル内のプログラム(今回の場合シート上の関数)を
使ってみると、VBA上ではループの回数を減らせる(内部的にはどうなっているか解らないが)ので、
それを使ってみて高速化できないかチャレンジしてみる。
Sub test3()
Dim wbk As Workbook Dim rng As Range Dim vv As Variant Dim v As Variant Dim i As Long Dim rngList As Range Dim m As Variant
Set wbk = Workbooks.Open(ThisWorkbook.Path & "\sample.csv") Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange With wbk.Sheets(1).UsedRange Set rngList = Intersect(.Cells, .Offset(3)).Resize(, 8) End With vv = rngList.Value v = WorksheetFunction.Transpose(rng.Columns(2))
For i = 1 To UBound(vv, 1) m = Application.Match(vv(i, 1), rng.Columns(1), 0) If IsNumeric(m) Then vv(i, 8) = v(m) Next
rngList.Value = vv
wbk.Close savechanges:=True End Sub
次に、
そもそも、1個1個に個別に計算の命令をすることも時間のかかる原因かも?
ということで、
マクロで無く普通に数式を入力したらどうなるだろうかやってみる。
1)自分のブックのデータ範囲に名前を定義しておき、
2)それを参照し表引きする関数(Vlookup関数)を1つ入力
3)フィルハンドルをダブルクリックで数式をコピー
4)csvで保存
多分最後の方法のようなアプローチが速い
(セルに一度に数式を入れれば、オートフィルの分がさらに高速化できる)と思います。
この手順をマクロ化してみるのもありだと思います。
(表計算ソフトなんだからこういう計算は得意なはずですよね?)
CSVで保存すれば計算式は自然に値になってるのではないかと思うのですが。。。
高速化を試みるならこの辺りを試してみるといいでしょう。
参考URL>>
http://officetanaka.net/excel/vba/speed/index.htm
https://tonari-it.com/excel-name-definition/
http://d.hatena.ne.jp/iroiro-memo/20140906/1410792047
https://kokodane.com/2013_kan_008.htm
全て思い付きで書きました。
間違いがあったらごめんなさいです。
参考になれば。。。
(まっつわん) 2018/03/13(火) 13:03
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.