[[20190911115458]]　『VBAの高速化』（fuji）　ページの最後に飛ぶ

『VBAの高速化』（fuji）

Excelで作成した点列データを、CADで読み込める形にするため、下の様なVBAを使用しています。
Excel2010では4分程度で完了していたのですが、PCの更新に伴いExcel2016にしたところ、PCのSPECは上がったにもかかわらず約40分と、10倍位時間がかかる様になってしまいました。
詳しい方、高速化する方法をアドバイスお願いします。

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    ChDir "C:\Temp"
    Sheets("002").Select
    ActiveWorkbook.SaveAs Filename:="C:\Temp\002.dat", FileFormat:=xlText, CreateBackup:=False
    Sheets("003").Select
    ActiveWorkbook.SaveAs Filename:="C:\Temp\003.dat", FileFormat:=xlText, CreateBackup:=False
	・
※以下同様の処理が約200回続く
	・
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 回答ではありませんが
 それぞれのテキストファイルの容量はどれくらいですか？

（渡辺ひかる） 2019/09/11(水) 12:29

違っていたらごめんなさいですけど、私が分かる範囲で見てもコード上に問題はなさそうなので、ステップ実行して原因を追っていくしかないのでは？

気になるとすれば、
＞※以下同様の処理が約200回続く

なので、ブックに200シートもあったらマクロ云々より、単純にブックが重すぎるのが原因じゃないかなぁと思います。

また、「ChDir "C:\Temp"」としていますが、ちゃんとフルパスを指定されていますから、カレントディレクトリを切り替える必要は無いと思います。

あと、シートを"選択”しているのが気になったので、↓みたいな感じにすれば”選択”はしなくてよいとおもいます。
（シートをコピーするから、かえって遅くなるかも？）

    Sub test()
        Dim SH As Worksheet

        For Each SH In ThisWorkbook.Worksheets

            SH.Copy
            With Workbooks(Workbooks.Count)
                .SaveAs _
                  Filename:="C:\Temp\" & .Worksheets(1).Name & ".dat", _
                  FileFormat:=xlText

                .Close
            End With

        Next SH

    End Sub

（もこな２） 2019/09/11(水) 12:43

2013以降のExcelでは「開く」のがとてつもなく遅くなる場合があります。
保存しようとしているブックはどうやって用意していますか？

完全では有りませんが、
Application.PrintCommunication=False
なども高速化に大きく影響があります。

（にゅるん） 2019/09/11(水) 13:25

皆様回答ありがとうございます。

（渡辺ひかる様）
テキストファイルの容量は13Kb程度です。

（もこな２様）
Excel2010では、ギリギリ実用的な速度（約4分）だったので、同じ位の時間でできる様にしたいです。

シート選択をやめる方法は、少し時間がかかるので、後でやって報告します。

（にゅるん様）
最初2枚のワークシートで計算を行っています。
3枚目以降のワークシートは、数値を参照しているだけのシートです。
VBAでは、3枚目以降のシートを、CSV形式で保存しています。

Application.PrintCommunication=False
やってみましたが、体感できる様な速度向上はありませんでした。

（fuji） 2019/09/11(水) 15:38

 データ構成はどのようになっていますか？
 列項目があってデータベース構造になっていれば、ADOで接続して
 GetStringからテキストファイルを生成した方が早い気がします。
（seiya） 2019/09/11(水) 15:43

（seiya様）
"ADOで接続してGetStringからテキストファイルを生成"
スミマセン私のスキルでは全く理解できません。
具体的な見本のマクロがあれば、真似してやってみるのですが・・・。

（fuji） 2019/09/11(水) 16:18

 データ構成がデータベース形式になっていなければ無駄ですよ？
 又、表示形式を使用している場合も無視します。
（seiya） 2019/09/11(水) 16:27

 ＞テキストファイルの容量は13Kb程度です。

 そうですか、遅くなる原因ではないようですね。

 もこな２さんのコードを試してみては？

（渡辺ひかる） 2019/09/11(水) 16:30

（もこな２様）
シート"選択"をやめて"コピー"にする方法について、やってみました。
＜結果＞
　実行時間　40分→2.5分　に短縮されました。

シート"選択"が速度低下の主原因だった様です。

（seiya様）
私のスキルでは無理そうなので今回は諦めます。

元々の約4分から短縮されたので、今回はここまでにしたいと思います。
皆様回答ありがとうございました。
（fuji） 2019/09/11(水) 16:41

 とりあえず、データ構成が条件を満たしている

 ということで、試してください。
 数秒で処理できると思います。

 Sub test()
    Dim cn As Object, rs As Object, ws As Worksheet
    Dim i As Long, txt As String, ff As Long, HDR As String
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    With cn
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 12.0;HDR=True"
        .Open ThisWorkbook.FullName
    End With
    For Each ws In Worksheets
        ff = FreeFile
        rs.Open "Select * From [" & Format$(Val(ws.Name), "000") & "$];", cn, 3
        For i = 0 To rs.Fields.Count - 1
            HDR = HDR & IIf(HDR = "", "", vbTab) & rs.Fields(i).Name
        Next
        Open ThisWorkbook.Path & "\" & Format$(Val(ws.Name), "000.dat") For Output As #ff
            Print #ff, Join(Array(HDR, rs.GetString(2)), vbNewLine);
        Close #ff
        rs.Close: HDR = ""
    Next
    Set rs = Nothing: Set cn = Nothing
 End Sub
（seiya） 2019/09/11(水) 17:12

（seiya様）
回答ありがとうございます。
上のコードでやってみました。確かに数秒で処理が完了します。

＜課題＞
出力するファイルは、受け取る側のCADソフトの制限で、x,y,zの座標データが羅列したデータになっており、項目行がありません。（つまりデータベース形式ではない）

各シートに項目行を追加してデータベース形式にし、出力時に、１行目（項目行）を除いて出力するようなことができれば、良いのですが、私のスキルではどうしたら良いかよく分かりません。

（fuji） 2019/09/12(木) 12:35

 1) HDR=True は HDR = Yes の間違いでしたが　No に変更
 >        .Properties("Extended Properties") = "Excel 12.0;HDR=True"
 を
         .Properties("Extended Properties") = "Excel 12.0;HDR=No"

 2) 下記を削除
        For i = 0 To rs.Fields.Count - 1
            HDR = HDR & IIf(HDR = "", "", vbTab) & rs.Fields(i).Name
        Next
 3) 
 >            Print #ff, Join(Array(HDR, rs.GetString(2)), vbNewLine);
 を
             Print #ff, rs.GetString(2);
 に変更でOKだと思います。
（seiya） 2019/09/12(木) 13:01

（seiya様）
回答ありがとうございます。
項目行なしで、できることを確認しました。数秒で処理が完了します。

もう一点だけ質問です。

出力するファイルは、","（カンマ）区切りである必要があるのですが、現状"tab"区切りになっています。
カンマ区切りにするにはどうしたら良いでしょうか？
（fuji） 2019/09/13(金) 10:37

 GetString メソッドでフィールド区切り文字を指定できます。
 rs.GetString(2,,",")
 としてやればカンマ区切りになります。

 修正後のゴミを整理すると、こんな感じです。

 Sub test()
    Dim cn As Object, rs As Object, ws As Worksheet, ff As Long
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    With cn
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 12.0;HDR=No"
        .Open ThisWorkbook.FullName
    End With
    For Each ws In Worksheets
        ff = FreeFile
        rs.Open "Select * From [" & Format$(Val(ws.Name), "000") & "$];", cn, 3
        Open ThisWorkbook.Path & "\" & Format$(Val(ws.Name), "000.dat") For Output As #ff
            Print #ff, rs.GetString(2, , ",");
        Close #ff
        rs.Close
    Next
    Set rs = Nothing: Set cn = Nothing
 End Sub

 100枚単位のシートを一々コピーして保存しなおすのは、それだけで時間がかかります。
 違う方法を知っておくと、無駄なストレスを感じなくて済みます。

 ここでのキーワードは、ADO接続とシーケンシャルモードでの出力 です。
 時間があったら調べてみてください。

（seiya） 2019/09/13(金) 10:59

（seiya様）
丁寧に解説ありがとうございます。
所望の形式で出力できる様になりました。

その後
CADで読み込みを確かめているのですが、なぜかうまくいきません。
数値の桁数が異なる（CSV出力の場合10桁に対し15桁）、
1111E-02等の指数形式で出力される場合がある。
等の違いが原因している可能性があります。
もう少しやってみます。
（fuji） 2019/09/13(金) 12:02

 各セルの実際の値が15桁になっていませんか?
 前述のとおり、表示形式とうは無視して実際のフォーミュラバーの値を読み込みます。
 もし10桁で区切るのならシートの値を10桁にする必要があります。
 列数が少なければSQL文中でどうにかなりますが...
 実際のデータの列数はどのくらいですか？

（seiya） 2019/09/13(金) 12:26

 それと、全て数値だったと思いますが、数値を丸める条件は何でしょう？
 例えば、小数点以下何桁まで、或いは左から何桁までとかですが？
（seiya） 2019/09/13(金) 12:39

（seiya様）

数値はExcelデフォルトのままで、数値をコピーして確認すると15桁でした。
CSV出力すると自動的に10桁で丸められる様です。

＜試しに＞
１．入力する値を調整して、指数データが出力されない様にする。
２．Round関数を使用して、数値の桁数を制限する。

をやってみたのですが、どちらもNGでした。
（fuji） 2019/09/13(金) 13:20

 データの列数
 数値の丸め方

 これを教えてください。

（seiya） 2019/09/13(金) 13:24

 これからしばらく出かけるので以下のように書いて試してください。

 現在
         rs.Open "Select * From [" & Format$(Val(ws.Name), "000") & "$];", cn, 3
 で全ての値をそのまま読み込んでいます。

 HDR=Noにすると、自動的にフィールド名が割り当てられます。
 F1, F2, F3, F4...

 以下のようにすると左から3列目までの値を少数2位で丸めます。
 少数以下切り捨てなら Fix(F1)

 なにもしなくて良い列は単に F1 でOKですが、全ての列数分記述する必要があります。
 即ち、 
 Select * は全てのフィールド
 Select F1 は最初のフィールドのみ
 という意味です。

 例；
         rs.Open "Select Round(F1,2), Round(F2, 2), Round(F3, 2) From [" & Format$(Val(ws.Name), "000") & "$];", cn, 3
（seiya） 2019/09/13(金) 13:49

金曜日午後から、他の仕事が入り検討が止まっていました。

（seiya様）
上のRound関数を使用したコードでやってみましたが、やはりCADで読み込めませんでした。
※テキストファイルの内容としては、意図通り出力されています。

CSV出力の場合
　12345.678912345　→12345.67891
　123.45678912345　→123.4567891
という風に有効数字が10桁になる様に数値が丸められるのですが、
Round関数の場合
　12345.678912345　→12345.67891
　123.45678912345　→123.45678
という風に、小数点以下の桁数が揃う様に四捨五入されているところが異なります。

上記が影響している可能性があります。

あるいは、テキストの形式が微妙に異なるのかもしれません。

（fuji） 2019/09/17(火) 16:10

（seiya様）
原因が分かりました。

出力されるテキストファイルの改行コードが"CRのみ"になっていることが原因でした。
改行コードを"CR+LF"に置換することにより、CADで読み込める様になりました。

有効桁数や、指数形式は関係ありませんでした。
（fuji） 2019/09/17(火) 17:00

（seiya様）
GetString メソッドで改行コードを"vbCrLf"に指定したところ、問題なく使用できる様になりました。

おかげ様で約40分かかっていた処理が、僅か数秒で完了するようになりました。
本当にありがとうございました。

（fuji） 2019/09/17(火) 18:15

 こんばんわ...遅くなりました。

 >有効数字が10桁になる様に数値が丸められるのですが、

 Left関数で10桁になるか試してください。

 rs.Open "Select Left(F1,10), Left(F2,10)....
（seiya） 2019/09/17(火) 20:17
 20:38 追記
 小数点が入るなら Left(F1,11)ですね。
 もし小数点が無い場合は10桁ということなら
 IIf(Fix(F1) = F1, Left(F1, 10), Left(F1,11)) な感じで試してください。

（seiya様）
回答が遅くなりましたが、Left関数で有効桁数を揃えることができることが確認できました。

上で記載の通り、CADで読み込めない原因は改行コードで、有効桁数や、指数形式は関係ありませんでした。
今回は、Left関数なしで使用します。

丁寧な解説ありがとうございました、大変勉強になりました。
（fuji） 2019/09/20(金) 12:06

コメント返信：

[ 一覧(最新更新順) ]

[[20190911115458]] 『VBAの高速化』（fuji） ページの最後に飛ぶ

[[20190911115458]]　『VBAの高速化』（fuji）　ページの最後に飛ぶ