テキストファイルから欲しい文字列を抽出したいのですが、時間がかかってしまいます。

Question

前提・実現したいこと

けっこう長いテキストファイルがいくつかあります。（1MB超えてるのが普通）
このなかのところどころに
busho('code001','部署名','担当者');
という記述があって
そこの部署コードと部署名と担当者が書いてあるところだけ集めたいのです。

書いたコード

Sub getBusho()

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim sBuf As String
With fso.GetFile("C:(フルパス)\text.txt").OpenAsTextStream
    sBuf = .ReadAll
    .Close
End With

Dim i As Long
Dim j As Long
Dim k As Long:  k = 1
Dim tmpBuf As String
For i = 1 To Len(sBuf)-6 Step 1
    If Mid(sBuf, i, 6) = "busho(" Then
        j = i
        tmpBuf = ""
        Do While Mid(sBuf, j, 2) <> ");" And j < Len(sBuf) - 6
            tmpBuf = tmpBuf & Mid(sBuf, j, 1)
            j = j + 1
        Loop
        Cells(k, 1) = tmpBuf
        k = k + 1
    End If
Next i

End Sub

取れるんですけど
めっちゃ時間かかります……。

これは何が悪くて時間がかかるのでしょうか。
無駄な処理があるのでしょうか。

補足情報（FW/ツールのバージョンなど）

Excel2016で、Windows10です。

Comments

[alg]

まず、「書いたコード」のどのステップが遅いのか、計測するべきかと思われます。

[sumire_cl]

計測！計測ってどのようにするのですか？そこからかよ！って感じでしょうが、すみませんそこからです……。

[papinianus]

誰か計測方法くらい教えたげてよ。http://officetanaka.net/excel/vba/tips/tips161.htm

Answer 1

重くなる原因として推測されるのは、

1. ループで一文字分ずつ移動して検索している、

文字数分のループが発生するので大きなテキストだと重くなる

1. 条件合致部分のテキストを取り出すのに、一文字ずつ連結している、

文字列連結の繰り返しは重くなる原因です。

1. 検索結果をセルに一個ずつ代入している、

その都度、再描画が発生するので結果件数が多いと重くなります。

前2つのの改善策としては、Instrを使うといいでしょう。

最後の原因の改善策は、検索結果を配列に格納して、最後に一気にセルに代入するといいでしょう。

ちなみに、数MBぐらいのテキストなら、1行ずつ読み込みより、一気に読み込んだ方が速いと思います。
（現在のPCのRAMは数GBが普通なので）

上記の改善策を適用させたコード例

Sub getBusho_Kai()

    Application.ScreenUpdating = False
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim sBuf As String
    With fso.GetFile("C:\TEST\Test.txt").OpenAsTextStream
        sBuf = .ReadAll
        .Close
    End With

    Dim k As Long: k = 0
    Dim p1 As Long: p1 = 1
    Dim p2 As Long
    Dim tmpBuf As String
    Dim ary()
    Do
        p1 = InStr(p1, sBuf, "busho(")
        If p1 = 0 Then Exit Do
        p2 = InStr(p1, sBuf, ");")
        If p2 = 0 Then Exit Do
        tmpBuf = Mid(sBuf, p1, p2 - p1 + 2)
        p1 = p2 + 2
        
        ReDim Preserve ary(k)
        ary(k) = tmpBuf
        k = k + 1
    Loop

    Range("A1").Resize(UBound(ary) + 1).Value = WorksheetFunction.Transpose(ary)
    Application.ScreenUpdating = True

End Sub

Comments

[sumire_cl]

他のかたの回答にもInStrを教えてくださったかたがいらっしゃったのですが
InStrだとなんで速くなるのかなというところがわからなかったのです。
そうか、これだと
私のだとループ回数は文字数ぶんですが
これだとbumonの数だけになるので、
回数が大幅に減ることになるわけですね！
性能ショボめのPCなので、ループ回数の差は顕著に出ると思います。

文字列連結は考え方が簡単なため結構頻繁に使ってしまうので、考えを改めようと思います。
3は配列でもいいし、ttyp03さんが教えてくださった描画OFFでも大丈夫そうな気がします。

皆様ありがとうございます、勉強になりました！

[hatena19]

私も通常は描画OFFだけでいいと思います。それでもまだ重くて改善したいというときに配列を使うといいでしょう。配列で速度を改善するという手段は覚えておくといろいろ使える場面があると思います。

Answer 2

一回ファイルを全部読んでから順次やっているから、というのが遅い原因の一旦かも知れません。

takasima20 さんの書いたように、1行ごとに読んで解釈して、の方が（メモリを食わないし）良いかと思います。
※行をまたがないことが条件になりますが

Answer 3

とりあえず出力をテキストファイルにしてみたらどうスか?

ついでに、(参考までに) VBScript で大まかなとこ書いときます。

Option Explicit
Dim objF,args,outf,outp,outs,inp
Set objF = CreateObject("Scripting.FileSystemObject")
Set args = WScript.Arguments

If args.count = 0 Then
  MsgBox "TXTファイルをドロップしてください。"
  WScript.Quit
End If

outf = objF.GetParentFolderName(args.item(0)) & "\hoge.txt"
Set outp = objF.OpenTextFile(outf,2,True)

If Ucase(objF.GetExtensionName(args.item(0))) = "TXT" Then
  Set inp = objF.OpenTextFile(args.item(0),1)
  Do Until inp.AtEndOfStream

    ' inp.ReadLine で一行読み込み
    ' 一行分の処理

    ' outp.WriteLine 出力内容
  Loop
  inp.Close
  Set inp = Nothing
End If

outp.Close
Set outp = Nothing
Set objF = Nothing
MsgBox "おわりました。"

Answer 4

確かに時間がかかりそうな処理に見えたので、実際にやってみました。
約4Mのテキストファイルに1000行ほどbushoの行を突っ込んでみました。
環境は、Excel2013+Windows7なので異なります。
結果、1秒強で終わりました。

bushoのデータがもっと大量にあるのなら、画面描画を抑制すると速くなる可能性はあります。
関数の始めと終わりで、Application.ScreenUpdatingを設定してみてください。

Sub getBuso()
    Application.ScreenUpdating = False
～
    Application.ScreenUpdating = True
End Sub

Comments

[sumire_cl]

1秒… 私はもっとかかります。PCショボいというのも大きな原因のひとつのような気がしました…

[ttyp03]

bushoは何個くらいあるんですか？

[sumire_cl]

テキストによって
ほとんど入ってないこともあるし
数百個くらいのときもあります。
大きくていっぱいあるときは、やっぱりちょっと待つ感じです。

Answer 5

InStr関数を使った方が良いです。
http://www.officetanaka.net/excel/vba/function/InStr.htm