- ベストアンサー
【VBA】For Nextなどを使わないコード
- VBAの質問です。約40000行30列のデータがあるブックが20個あり、処理を毎日やるのですが、マクロの時間がかかりすぎてしまいます。for NextやFor Eachなどの1行ずつ処理するコードを使わず、一気に処理することはできないのでしょうか?
- VBAで処理する際に、約40000行30列のデータがあるブックが20個あり、処理自体は単純なものの、データ量が膨大でマクロの時間がかかりすぎる問題があります。for NextやFor Eachなどの1行ずつ処理するコードを使わず、一気に処理する方法はないでしょうか?
- VBAを使用しており、処理対象のデータが約40000行30列のブックが20個あります。処理は単純なものですが、データ量が膨大でマクロの実行時間が非常に長くなってしまいます。for NextやFor Eachなどの1行ずつ処理するコードを使用せずに、一括で処理する方法はありますか?
- みんなの回答 (8)
- 専門家の回答
質問者が選んだベストアンサー
#5、cjです。 お礼欄でお尋ねの件ですが、 ・私の想定と異なる部分で不適切な設計(エラーの原因)になっていた為、 ご質問のコード部分は書き換えることになりました。 ・配列変数の宣言、定義、については、 正しく基本を理解して貰えるような "教授" は、 この場では(物理的に)無理と判断しました。 以上の理由で直接お応えすること遠慮します。 代りに、新たな設計のコードを説明コメント付きで提示することで、 お求めの "教示" に対して参考になっていれば幸いです。 基本事項については、 【vba 配列変数】 【vba 配列変数の定義】 【vba 配列変数 再定義】 などのWeb検索で、学習ベースの解説が閲覧できると思います。 【vba scripting.dictionary】 連想配列についても調べてみてください。 # 多少応用的な書き方をしているので少し解説 # 基本的には辞書に登録しておいて、答えを調べるような使い方をします。 Set oDict = CreateObject("Scripting.Dictionary") oDict("abc") = 19 oDict("def") = 82 以上の登録によって、 Key:"abc" に対応する Item:19 Key:"def" に対応する Item:82 と設定され、 MsgBox oDict("abc") ' → 19 MsgBox oDict("abc") ' → 82 のようにKeyに関連付けられたItenを高速に呼び出すことが出来ます。 今回はVLOOKUPの代りに用いています。 Sub mRe8260540d() Dim mtxS As Variant ' セル範囲(行 * 列)を二次元配列(変数:行 * 列)に採り込む変数 Dim mtxP As Variant ' 二次元配列(変数:行 * 列)をセル範囲(行 * 列)に吐き出す変数 Dim oDict As Object ' Scripting.Dictionary 検索値に対応した値を取り出し易くする連想配列 Dim rngT As Range ' 作業セル範囲 並べ替えの基準となる値を出力して処理後に消去 Dim tnRow As Long ' 行数(=A列の最下行位置)を取得 Dim tnCol As Long ' 作業セル範囲の列位置(=使用中のセル範囲の列数+1)を取得 Dim i As Long ' ループ用 With Application ' ' 描画更新を中止 .ScreenUpdating = False ' ' イベント発効を中止 .EnableEvents = False ' ' 数式の自動計算を中止 .Calculation = xlCalculationManual End With With Sheets("Sheet1") ' ◆要指定◆ シート名 ' .Select ' 選択する必要はない(してもいい) ' ' ●●● 不要行削除 ●●● ' ' 行数(=A列の最下行位置)を取得 tnRow = .Cells(Rows.Count, 1).End(xlUp).Row ' ' C:D列(行数分)の値を配列変数に採り込む mtxS = .Range("C1:D" & tnRow).Value ' ' 作業セル範囲に出力する配列変数のサイズを再定義並べ替えの基準となる値をして処理後に消去 ReDim mtxP(1 To tnRow, 1 To 1) As Variant ' ' 2行め から 行数 までループ For i = 2 To tnRow ' ' 作業セル範囲に出力する 並べ替えの基準となる値の 二次元配列を 設定 ' ' 「C列の値が"aa"」または「D列の値が空」ならば True、それ以外は False mtxP(i, 1) = mtxS(i, 1) = "aa" Or mtxS(i, 2) = "" Next i ' ' 作業セル範囲の列位置(=使用中のセル範囲の列数+1)を取得 tnCol = .UsedRange.Columns.Count + 1 ' ' 作業セル範囲をオブジェクト(Range型)変数に確保 Set rngT = .Columns(tnCol).Resize(tnRow).Cells ' ' 作業セル範囲に 並べ替えの基準となる値の 二次元配列を 出力 rngT.Value = mtxP ' ' 作業セル範囲を基準に 表全体を 昇順で 並べ替え ' ' →先頭行(2行め)以下:上層は False、最下行より上:下層は True .Cells.Resize(tnRow, tnCol).Sort Key1:=rngT(1), Order1:=xlAscending, Header:=xlYes ' ' 作業セル範囲の2行め以下、値が2行め(False)と異なる(Trueの)セル範囲を取得して '’行ごと、クリア rngT.Offset(1).ColumnDifferences(rngT(2)).EntireRow.Clear ' .ClearContents ' ' 作業セル範囲の値を(不要になったので)消去 rngT.ClearContents '’YsedRangeを更新して、Ctrl+Endなどの一般機能を正しく動作するように修正。 .UsedRange ' ' ●●● 連想配列作成 ●●● ' ' Sheet2!A2:B8 の値を配列変数に採り込む mtxS = Sheets("Sheet2").Range("A2:B8").Value ' ' Scripting.Dictionary への参照を作成しオベジェクト型変数に格納 Set oDict = CreateObject("Scripting.Dictionary") ' ' Sheet2!A列を Key、Sheet2!B列を Format$関数に掛けて Item に 設定 For i = 1 To 7 ' UBound(mtxS) oDict(mtxS(i, 1)) = Format$(mtxS(i, 2), "'00") Next i ' ' ●●● セル範囲(表全体)を二次元配列変数に採り込む ●●● ' ' 不要行削除後の、行数(=A列の最下行位置)を取得 tnRow = .Cells(Rows.Count, 1).End(xlUp).Row ' ' A:L列(行数分)の値を配列変数に採り込む mtxS = Range("A1:L" & tnRow).Value ' ' ●●● 配列変数の中身(要素)を書き換える ●●● ' ' 2行め から 行数 までループ For i = 2 To tnRow ' ' 2列め ← 1列め mtxS(i, 2) = Mid$(mtxS(i, 1), 4, 2) ' ' 3列め ← 3列め mtxS(i, 3) = oDict(mtxS(i, 3)) ' ' 4列め ← 4列め mtxS(i, 4) = IIf(Left$(mtxS(i, 4), 1) = "Z", mtxS(i, 5), mtxS(i, 4)) ' ' ← 7列め(日付) に対しては何もしません ' ' 11列め ← 2列め & 3列め( '00 形式でフォーマット済) mtxS(i, 11) = mtxS(i, 2) & Mid$(mtxS(i, 3), 2) ' ' 12列め = 7列め mtxS(i, 12) = mtxS(i, 7) Next i ' ' ●●● セル範囲の表示形式 設定 ●●● .Range("C2:C" & tnRow).NumberFormatLocal = "@" .Range("(G:G,L:L) 2:" & tnRow).NumberFormatLocal = "yyyy/mm/dd" ' ' ●●● 配列変数の値をまるごとセル範囲に出力 ●●● .Range("A1:L" & tnRow).Value = mtxS End With With Application ' ' 描画更新を再開 .ScreenUpdating = True ' ' イベント発効を再開 .EnableEvents = True ' ' 数式の自動計算を再開 .Calculation = xlCalculationAutomatic End With ' ' 不要になったオブジェクト変数を 解放 Set rngT = Nothing: Set oDict = Nothing MsgBox "done" End Sub
その他の回答 (7)
- cj_mover
- ベストアンサー率76% (292/381)
#7、cjです。 文字数制限4000字ぴったりに収めることに気を取られて失敗してました。 冒頭部後半の解説について、訂正です。すみません。 【vba scripting.dictionary】 連想配列についても調べてみてください。 # 多少応用的な書き方をしているので少し解説 # 基本的には辞書に登録しておいて、答えを調べるような使い方をします。 Set oDict = CreateObject("Scripting.Dictionary") oDict("abc") = 19 oDict("def") = 82 以上の登録によって、 Key:"abc" に対応する Item:19 Key:"def" に対応する Item:82 と設定され、 MsgBox oDict("abc") ' → 19 MsgBox oDict("def") ' → 82 ★ のようにKeyに関連付けられたItenを高速に呼び出すことが出来ます。 今回はVLOOKUPの代りに用いています。 ★の行が訂正部分です。 一応、#7を元に仕上げるとなると、 また、こちらの想定が外れていることも出てくるとは思います。 原質問でご提示のコードで目に付いた点を事前に指摘しておくと、 > Cells(f, 3) = Format(Application.VLookup(Cells(f, 3), Sheets(2).Range("A2:C8"), 2, 0), "00") > Cells(f, 7) = Format(Cells(f, 7), "yyyy/mm/dd") これらの記述は、それぞれ、 「数値を2桁の数字に整えて文字列として出力」 「日付値を"yyyy/mm/dd"形式の文字列として出力」 という意図で書かれたものかも知れませんが、 セルの書式、表示形式、によって実行結果が左右されます。 簡単な例で、 Cells(1, 1) = Format(91, "00") Cells(1, 2) = Format(Date, "yyyy/mm/dd") のように実行すると、 セルの書式、表示形式、が、標準、の場合は、 数値としての 91 日付値としての 2013/9/14 になります。 セルの書式、表示形式、が、文字列、の場合は、 文字列値としての "91" 文字列値としての "2013/09/14" になります。 従って、指摘する2つの記述については、 セルの書式、表示形式、が、標準、の場合は、 Format関数は、効果なし ということになります。 Excelに代表される表計算アプリケーションでは、 数値(日付値)を優先的に判断して、データ型をコンバートしてしまいますから、 仮に文字列値と出力することがうまく出来たとしても、 編集を繰り返すうちに思わぬところで勝手に データ型がコンバートされてしまうことが多いです。 少しでも堅牢な文字列値にする為には、 先頭にアポストフィ(プレフィクス)を付けて、文字列を強制しておいた方が安心です。 例示を書き換えると Cells(1, 1) = Format(91, "'00") Cells(1, 2) = Format(Date, "'yyyy/mm/dd") セルの書式、表示形式、に、依存せず、どんな場合も、 文字列値としての "91" 文字列値としての "2013/09/14" となり、値と同じ様に表示されます。 ただ、この場合でも、 セルの書式、表示形式、を、文字列 に設定しておいた方がファイルとしての整合性が取れ、より堅牢になります。 なお、セルを編集状態にした場合や、数式バーに表示される内容は '91 '2013/09/14 です。先頭のアポストフィーは、隠れた役物記号、です。 もう一つ考えないといけないのですが、ご提示のコード、だけでは、 意図を汲み取れない点として、或いは、 Cells(1, 1).NumberFormatLocal = "00" Cells(1, 1) = 91 Cells(1, 2).NumberFormatLocal = "yyyy/mm/dd" Cells(1, 2) = Date のように、 セルの書式、表示形式、だけ指定して 数値や日付値のまま出力する、 ことだけで、事足りているのかも知れません。 私が書いたものでは、 > Cells(f, 3) = Format(Application.VLookup(Cells(f, 3), Sheets(2).Range("A2:C8"), 2, 0), "00") → セルの書式、表示形式、を、文字列 → 先頭にアポストロフィを付加した2桁数字文字列 > Cells(f, 7) = Format(Cells(f, 7), "yyyy/mm/dd") → セルの書式、表示形式、を、"yyyy/mm/dd" → 値は日付型のまま、変更を加えない という書き方をしています。 こういう細かい処は、ひとつひとつ、要求、と、確認、を 繰り返さないと、望み通りにいかない訳ですが、 ひとりで仕上げる時にも注意して、事前に確認するように心がけた方が、 作業効率が上がると思いますので、指摘の件、少し考えてみてください。
- cj_mover
- ベストアンサー率76% (292/381)
#5、cjです。 |現在、この回答はサポートで内容を確認中です。| |ご迷惑おかけいたしますが、今しばらくお待ちください。| とのことで15時間たった今、未だ表示されないサイトもあるようで、(^^; 不本意ながら、ご迷惑かけて、スミマセン。 一点、訂正があります。 Sub Re8260540() (後半)の 39行め mtxS = Range("A1:L" & tnRow).Value 誤りでした。 正しくは mtxS = .Range("A1:L" & tnRow).Value となります。 お手数ですが、以上訂正お願いします。 失礼しました。
- cj_mover
- ベストアンサー率76% (292/381)
お邪魔します。 参考までに2例、書いてみました。 どちらも配列操作で遅さを回避しています。 まず、 "For Nextなどを使わない" ことに拘った記述。 実用向きではないですが、こんなテクニックも 有るといえば有る、という程度のもの。(案外速い?) 計算は殆ど(VBAではなく)Excelにやらせています。 次に、配列変数を使ってセル範囲の値をIN/OUTする記述。 削除せずに並び替えをすることで遅さを軽減します。 こっちは結構、日頃から私が実践している技法が多いです。 速くする方法は他に多数あるけど、ホドホドにしてます。 具体的なシートイメージなしで書いてますし、 細かい要求仕様なんかは想像で補っている訳ですから、 こちらのテスト環境で動作確認できているものの、 細部までお望みのものになっているとは考えられません。 あくまでも参考、です。 あまり解説する気はありませんけれど、 お尋ねあれば、なるべくお答えします。 Sub Re8260540j() Dim mtxP As Variant Dim rngT As Range Dim lRow As Long With Application .ScreenUpdating = False .EnableEvents = True .Calculation = xlCalculationManual End With With Sheets("Sheet1") ' ' .Select lRow = .Cells(Rows.Count, 1).End(xlUp).Row mtxP = .Evaluate("1/((c2:c" & lRow & "=""aa"")+(d2:d" & lRow & "=""""))") With .Columns(.UsedRange.Columns.Count + 1).Resize(lRow - 1).Offset(1) .Value = mtxP .SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete .ClearContents End With lRow = .Cells(Rows.Count, 1).End(xlUp).Row Set rngT = .Range("A2:L" & lRow) rngT.Columns(2).Value = .Evaluate("index(mid(a2:a" & lRow & ",4,2),0,1)") With .Columns(.UsedRange.Columns.Count + 1).Resize(lRow - 1).Offset(1) .FormulaArray = "=text(index('Sheet2'!b2:b8,match(c2:c" & lRow & ",'Sheet2'!a2:a8,0),0),""'00"")" rngT.Columns(3).NumberFormatLocal = "@" rngT.Columns(3).Value = .Value .ClearContents End With rngT.Columns(4).Value = .Evaluate("index(if(left(d2:d" & lRow & ",1)=""Z"",e2:e" & lRow & ",d2:d" & lRow & "),0,1)") rngT.Columns(7).NumberFormatLocal = "yyyy/mm/dd" rngT.Columns(11).Value = .Evaluate("index(b2:b" & lRow & "&c2:c" & lRow & ",0,1)") rngT.Columns(7).Copy rngT.Columns(12) lRow = .UsedRange.Row End With With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With MsgBox "done jj" End Sub Sub Re8260540() Dim mtxS As Variant Dim mtxTmp As Variant Dim mtxD(0 To 99) As Variant Dim rngT As Range Dim tnRow As Long Dim tnCol As Long Dim i As Long With Application .ScreenUpdating = False .EnableEvents = True .Calculation = xlCalculationManual End With With Sheets("Sheet1") '' .Select tnRow = .Cells(Rows.Count, 1).End(xlUp).Row mtxS = .Range("A1:L" & tnRow).Value ReDim mtxTmp(1 To tnRow, 1 To 1) As Variant For i = 2 To tnRow mtxTmp(i, 1) = mtxS(i, 3) = "aa" Or mtxS(i, 4) = "" Next i tnCol = .UsedRange.Columns.Count + 1 Set rngT = .Columns(tnCol).Resize(tnRow).Cells rngT.Value = mtxTmp .Cells.Resize(, tnCol).Sort Key1:=rngT(1), Order1:=xlAscending, Header:=xlYes rngT.Offset(1).ColumnDifferences(rngT(2)).EntireRow.Clear ' .ClearContents rngT.ClearContents .UsedRange mtxTmp = Sheets("Sheet2").Range("A2:B8").Value For i = 1 To UBound(mtxTmp) mtxD(mtxTmp(i, 1)) = mtxTmp(i, 2) Next i tnCol = .UsedRange.Columns.Count + 1 mtxS = Range("A1:L" & tnRow).Value For i = 2 To tnRow mtxS(i, 2) = Mid$(mtxS(i, 1), 4, 2) mtxS(i, 3) = Format$(mtxD(mtxS(i, 3)), "'00") mtxS(i, 4) = IIf(Left$(mtxS(i, 4), 1) = "Z", mtxS(i, 5), mtxS(i, 4)) ' mtxS(i, 7) = Format$(mtxS(i, 7), "yyyy/mm/dd") mtxS(i, 11) = mtxS(i, 2) & Mid$(mtxS(i, 3), 2) mtxS(i, 12) = mtxS(i, 7) Next i .Range("C2:C" & tnRow).NumberFormatLocal = "@" .Range("(G:G,L:L) 2:" & tnRow).NumberFormatLocal = "yyyy/mm/dd" .Range("A1:L" & tnRow).Value = mtxS End With With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With MsgBox "done" End Sub
お礼
2例もご提示いただきありがとうございます。 2番目の配列変数に組み込んで吐き出す方法でやってみたいと思います。 一点、教えていただきたいところがあるのですが、 For f = 1 To UBound(mtxTmp) mtxD(mtxTmp(f, 1)) = mtxTmp(f, 2) Next f のところはどんな処理をしてるのでしょうか? Dim mtxD(0 To 99) As Variant という宣言も初めて見たのでよく分からないでいます。 実はここでエラーが出てしまって、原因を特定できない状態です。
- mitarashi
- ベストアンサー率59% (574/965)
皆さんが仰っている事と重なりますが、下記が考えられます。 1.セルにアクセスするのを止めて、一括で配列に取込み、メモリ上で処理して、一括でセルに書き戻す方法 For~Nextを使っても格段に高速です。セルの書式で調整が必要になる場合があります。 http://officetanaka.net/excel/vba/speed/s11.htm 2.範囲全体に一括で式を与えて、再計算が始まると時間がかかるので、すぐに値に置き換えてしまう方法 R1C1方式の方が分かり易いです。R1C1表示に切り替えて、自動記録すると頭を使わないでも取得できます。 Sub test() Dim myRange As Range Set myRange = Range("C1:C10000") myRange.FormulaR1C1 = "=RC[-2]+RC[-1]" myRange.Value = myRange.Value End Sub 3.他の案もありますが、具体的なデータの姿が見えないと考えにくいです。 以上、ご参考まで。
- 山田 太郎(@f_a_007)
- ベストアンサー率20% (955/4574)
【参考意見】直接的ではありませんが・・・。 問題は、高速化の必要性の程度かと思います。 1、10倍速、20倍速とかが要求されているのか? 2、それとも、1秒以内という超高速化か? 1ならば、「CSVファイル管理」へ移行する。 (1)CSV選択。 (2)更新。 (3)テキスト形式表示。 (4)Excel形式表示。 ※「CSVファイル管理」画面だけで作業できるので作業が簡単。 ※CSVファイルを配列に読み込んで変更するだけだから高速。 ※Excelでも参照できる。 2ならば、 (1)データファイル選択。 (2)データファイル更新。 (3)テキスト形式表示。 (4)Excel形式表示。 ※データファイルは必ずCSVでも保存。 ※データファイルとは配列変数をバイナリ保存したもの。 <配列変数をバイナリ保存> あんまり難しく考えないで、ランダムファイの1レコードを読み書きするだけでも目的は達成されます。
お礼
CSVで処理するほうが断然早いんですね。 知りませんでした。 一旦XLSで頑張ってみて、それでも無理そうならチャレンジしてみます。
- FEX2053
- ベストアンサー率37% (7991/21371)
どっちかというと Format(Application.VLookup(Cells(f, 3), Sheets(2).Range("A2:C8"), 2, 0), "00") これの所要時間の方が問題のような気がしますが。 Applicationを呼ぶと結構な時間がかかりますので。 それと、セルへの書き込みは、セルからのデータ取得 よりものすごく時間がかかります。いったん全部のデータを 変数として取得して、内部で計算して、式を使わず結果を 直接書き込む方がいいと思います。
お礼
なるほど。 findで探すより、ワークシート関数のVLOOKUPを使ったほうが速度的には速いとどこかで見たのですが、それでもなお遅いということでしょうか。 No.5さんにご提示いただいた、一旦全て二次元配列に組み込む方法で試してみたいと思います。
- chie65536(@chie65535)
- ベストアンサー率44% (8740/19838)
「あとでまとめてやる」のではなく「セルの内容が変化した時、変化した範囲だけ、イベントマクロで処理する」にした方が良さげです。 あと、K列は、K2に「=B2 & C2」って式を入れておいて、表の全部の行にコピーしておけば良いのでは? てゆか、どれもこれも「セルに式として書ける」のに、なんで式として書かないんですか? 「式じゃなく、値として入ってないと困る」って言うなら、すべて式で書かれてるシート1を全部範囲指定して、コピー、形式を指定して貼り付けで「値のみ」で貼り付け、その後、ブックを別名で保存して、式で書かれてるブックは書き換えずに、翌日また使う、と言う方法で「式じゃなく、値として入っている状態」に出来ますよ。
お礼
ご回答ありがとうございます。 ファイル自体は毎日自動生成されるもので、あらかじめシートに式を入れておくことができないのです。 説明不足ですみません。 仰るように関数の入っているブックに一旦貼り付けて計算してから値で戻す方法も考えたんですが、データ量的にVBAの方が早いかと思い、挑戦した次第です。
お礼
お礼に時間がかかってしまい申し訳ありません。 自分なりに色々勉強し、ようやく全てではありませんがおぼろげに理解に至ることができました。 詳細な解説も加えていただきありがとうございます。 とてもわかりやすく、コード自体が無駄のないすごく合理的なものであることがわかりました。 >具体的なシートイメージなしで書いてますし、 >細かい要求仕様なんかは想像で補っている訳ですから、 >こちらのテスト環境で動作確認できているものの、 >細部までお望みのものになっているとは考えられません。 >あくまでも参考、です。 とのことですが、こちらの望み通りのものが出来上がりました。 連想配列というのも初めて知りました。 一旦配列変数に取り込んだデータの各要素を、別のデータを参照して上書きするという処理になるのでしょうか。 VLOOKUPの変わりだけでなく、色んな可能性を感じました。 件の表示形式については、完全に理解できました。 元々のデータはcsvで吐き出されたものを新規のexcelに取り込んで処理しているため、 全てのセルの表示形式が「標準」になっていることは確実に担保されています。 このため、最初に列ごとセルの書式、表示形式だけ指定して数値や日付値のまま出力する方法に使用と思います。 自分でも使いこなせるよう更に勉強したいと思います。 本当にありがとうございました。