エクセルのVBAの動作の高速化について

エクセルのVBAの高速化を行いたいと思い質問させていただきます。

現在、きまった形のデータを作成するために、コピーandペースト作業時のミスをなくすためエクセルとVBAを使いフォーマットを作成しました。
エクセルに決まった通りにデータを入力したら、後はVBAで自動的に決まった形のテキストデータを出力してくれるというマクロであります。
当初、データ数がそこまで多くなく軽快に作業が進んでいたのですが、データ数と繰り返しステップ数が増えると作業終了までにかなりの時間がかかるようになりました。それこそ、列ごとにテキストエディタに書きこんだ方が早いかもしれないと思うようにもなりました。（実際に試したのですが、途中で選択範囲を間違えたり、重複で張り付けたりで散々でしたが…）。

セルに(下記はセル番地を示す)
B2 C2 D2 ・・・ XX2
B3 C3 D3 ・・・ XX3
B4 C4 D4 ・・・ XX4
・・・・・・・
B500000 C500000 D500000 ・・・XX500000
とセル番地に文字が入力されていたら
B2
B3
B4
・
B500000
-1, 0.,
C2
C3
C4
・
C500000
-1, 0.,
D1
D2
D3
・
D500000
-1, 0.,

この間繰り返し

XX1
XX2
XX3
・
XX500000
-1, 0.,
-1
とテキスト形式の文字が列ごとに繋がっていく感じであります。(各列のデータの区切りに-1, 0.,という終了フラグが付きまして、EOFの時には -1というフラグが付きます)
各列の終了行数は全部同じであります。(つまり2行目から始まり、5万行データなら5万行まで、70万行なら70万行まで全列データがある矩形型)

今現在のコードを記載します。

vba
1Sub 結果作成()
2Application.ScreenUpdating = False
3Dim ファイル名 As String
4ファイル名 = InputBox("出力ファイル名称を入力")
5
6outputPath = ThisWorkbook.Path & "\" '出力ファイルの保存先決定
7出力ファイル = outputPath & ファイル名 & ".dat" 'datという拡張子
8
9Dim i As Long, LngLoop As Long
10Dim IntFlNo As Integer
11
12IntFlNo = FreeFile '空いているファイル番号取得
13Open 出力ファイル For Output As #IntFlNo
14
15'テキストファイルへの書き込み
16
17Worksheets("節点値").Activate 
18Dim ν As Long
19ν = Range("XFD2").End(xlToLeft).Column '列数取得
20
21Worksheets("節点値").Activate '行数取得
22Dim μ As Long
23μ = Range("b1048576").End(xlUp).Row
24
25Worksheets("節点値").Activate '時系列結果書き込み
26Dim Ξ As Long
27Dim Ψ As Long
28
29For Ξ = 2 To ν '時刻歴繰り返し 'B列から開始
30For Ψ = 2 To μ '節点数繰り返し '2行目から開始
31Worksheets("節点値").Activate
32    Print #IntFlNo, Cells(Ψ, Ξ)
33Next Ψ
34     Print #IntFlNo, "-1, 0.,"   '列ごとの終了フラグ記入
35Next Ξ
36    Print #IntFlNo, "   " & -1 'EOFのフラグ記入
37Close #IntFlNo '書き込み終了
38Application.ScreenUpdating = True
39End Sub

という状況であり、やっていることは単純に、列ごとにその列の最終行までのデータを
Print #IntFlNo, Cells(Ψ, Ξ)
で書き出してるマクロであります。

しかしながらごくまれに5万行×100列というデータもありすごく時間がかかるものもあります。

そこで、教えて頂きたい点としては、
For Ξ = 2 To ν '時刻歴繰り返し 'B列から開始
For Ψ = 2 To μ '節点数繰り返し '2行目から開始
Worksheets("節点値").Activate
Print #IntFlNo, Cells(Ψ, Ξ)
Next Ψ
Print #IntFlNo, "-1, 0.," '列ごとの終了フラグ記入
Next Ξ
Print #IntFlNo, " " & -1 'EOFのフラグ記入

で「出力ファイル = outputPath & ファイル名 & ".dat"」
に現在記述していますが、
それを列単位で
「出力ファイル = outputPath & ファイル名 & ".dat"」
に書き出せないかという事です。

例えばB列からZ列まで列数があり(25列)
2行目から50000行まで行数があるとすると

For next構文開始
B2からB50000までをコピーして
出力ファイルに書き込み
列ごとの終了フラグである「-1, 0.,」という固定文字を書きこみ
C2からC50000までをコピーして
出力ファイルに書き込み
列ごとの終了フラグである「-1, 0.,」という固定文字を書きこみ
・
・
Z2からZ50000までをコピーして
出力ファイルに書き込み
列ごとの終了フラグである「-1, 0.,」という固定文字を書きこみ
For next構文終了
EOFのフラグである「-1 」
を書きこみ。

といった感じにすれば早くなりそうな気がするのですが、上記のような構文の書き方が分かりません。それを教えていただきたいです。

使用しているパソコンで試したところ、B2からJ1048576までにそれぞれのセルに半角8文字を入力した状態でコピーをして、それをテキストエディタに張り付けるという事はできたため、メモリー自体は上記のように作業を行ったとしても耐えることができると思われます。

自分で書いたFor next構文の問題が解消できれば随分早くなると思うのでお知恵をお貸しください。

hatena19

2017/01/21 02:03

コードはコードタグで囲んでください。コード部分を選択して、「コード」ボタン(</>)をクリックするとできます。

行動規範の内容に同意します

回答1件

ベストアンサー

Print # メソッドだと１行ずつファイルに書き出すことなるので、行数が多くなると遅くなります。
出力するテキストを変数に格納して、それを FileSystemObject で一気に書き出すと改善されるでしょう。

あと、Worksheets("節点値").Activate でシートを指定するのではなく、直接Worksheetオブジェクトを参照するほうがいいでしょう。

上記の点を考慮して、自分なりに、コードを書き直してみました。

VB
1Public Sub 結果作成1()
2    Dim outStr As String
3    Dim C As Long, R As Long
4
5    '出力文字列生成
6    With ThisWorkbook.Worksheets("節点値")
7        For C = 2 To .Range("XFD2").End(xlToLeft).Column  '時刻歴繰り返し 'B列から開始
8            For R = 2 To .Range("b1048576").End(xlUp).Row  '節点数繰り返し '2行目から開始
9                outStr = outStr & .Cells(R, C) & vbCrLf
10            Next
11            outStr = outStr & "-1, 0.," & vbCrLf   '列ごとの終了フラグ記入
12        Next
13        outStr = outStr & "   " & -1    'EOFのフラグ記入
14    End With
15
16    Dim FileName As String
17    Dim outputPath As String
18    Dim OutFile As String
19
20    FileName = InputBox("出力ファイル名称を入力")
21    outputPath = ThisWorkbook.Path & "\"    '出力ファイルの保存先決定
22    OutFile = outputPath & FileName & ".txt"    'datという拡張子
23
24    Dim FSO As Object
25
26    Set FSO = CreateObject("Scripting.FileSystemObject")
27    With FSO.CreateTextFile(OutFile)
28        .Write outStr
29        .Close
30    End With
31    Set FSO = Nothing
32
33End Sub

返信に対する追記

書き込みを行う前にいくらか他のセルに打ち込んだ文字列を
Print 構文を使い事前に書きこませたいです。その場合にはどのようにすれば良いでしょうか？

Print は、
Open 出力ファイル For Output As #IntFlNo
で開いたファイルに１行ずつ書き込んでいくものです。
Open メソッドと Print メソッドはセットになります。
ですので、今回の回答のコードでは Print は使いません。

VB
1With FSO.CreateTextFile(OutFile)
2    .Write outStr
3    .Close
4End With

は、変数outStr に格納されている文字列を一気にファイルに書き出すものです。

これを理解しておいてください。

などのようにメモ書きをヘッダーとして書きこんでおきたいという事です。

変数 outStr に事前に希望の文字列を代入しておくだけです。

「メモ書き」がどこにあるのか不明ですが、
「メモ書き」というシートのA1セルにあるなら、

VB
1Public Sub 結果作成1()
2    Dim outStr As String
3    Dim C As Long, R As Long
4
5    outStr = ThisWorkbook.Worksheets("メモ書き").Cells(1, 1) 'これを挿入
6
7    '出力文字列生成
8    With ThisWorkbook.Worksheets("節点値")
9 
10 '以下略

投稿2017/01/21 03:02

編集2017/01/21 08:23

hatena19

総合スコア34352

tomituki

2017/01/21 06:02

ありがとうございます。動作がすごく早くなりました。変数に格納してくれる方法を教えていただきありがとうございます。このように使えば高速化処理ができるという事が分かり、勉強になりました。もう少し教えてください。今回、 ___ With FSO.CreateTextFile(OutFile) .Write outStr .Close End With ___ の部分で書きこみを行っていると思うのですが、書き込みを行う前にいくらか他のセルに打ち込んだ文字列を Print 構文を使い事前に書きこませたいです。その場合にはどのようにすれば良いでしょうか？たとえば解析プログラム名何月何日作成時刻歴 1 2 3 4 5 ・ x秒前などのようにメモ書きをヘッダーとして書きこんでおきたいという事です。そのため .Write outStr の前にprint構文であらかじめ処理しておきたいという欲ができてしまいました。後から使用を述べてしまい、申し訳ありません。なお、自分で With FSO.CreateTextFile(OutFile) のあとに Print #IntFlNo, Cells(x, y) というように(xとyは変数として作成してfor next関数で回す）をやったのですが、#IntFlNoが不正ですと出てしまいました。