文字列結合を便利で高速に処理するTextSystemクラス

Excel VBA(Visual Basic.netでも?)で文字列を結合するには、

Text = "abc" & "def"

のように&演算子を使うのが簡単ですが、実行回数が1000回、10000回と増えると実行時間がめちゃめちゃ長いです。

SQL文を生成したり、競馬データJVDataのレコードの複数の項目を結合するのに&演算子を使っていたのですが、あまりに処理に時間がかかるのでやめました。

Join()Array()で文字列を結合すれば、&演算子よりは処理が速くなります。

Text = Join(Array("abc", "def"), "")

この方法もJoin関数の呼び出し回数が増えると処理に時間がかかります。Join関数の呼び出し回数を工夫して少なくすれば使える方法です。

JVDataをSQLiteデータベースに変換するには、SQL文生成など文字列を結合する場面が多いです。

そこで、Midステートメントをベースにしたテキスト処理クラスTextSystemを作りました。

Option Explicit

' プライベート定数定義
Private Const MAX_TEXT_LENGTH As Long = 5 * 1024  ' 10KBの文字列領域を確保する

' プライベート変数定義
Private m_TextSpace       As String ' 文字列を蓄積する変数
Private m_Pointer         As Long   ' m_TextSpaceのポインタ
Private m_TextSpaceLengh  As Long   ' m_TextSpaceの文字数

' 文字列領域を初期化する
Private Sub Class_Initialize()
  m_TextSpaceLengh = MAX_TEXT_LENGTH
  Clear
End Sub

' 蓄積したテキストを返す
' 値渡しだから参照渡しより処理が遅い
Public Property Get Text()
  Text = Mid(m_TextSpace, 1, m_Pointer)
End Property

' 蓄積できる文字列領域を設定する
' これまでに蓄積した文字列はリセットする
Public Property Let MaxTextLength(ByRef Value As Long)
  m_TextSpaceLengh = Value
  Clear
End Property

' 文字列領域をスペースで埋めてポインタを0に設定する
Public Sub Clear()
  m_TextSpace = Space(m_TextSpaceLengh)
  m_Pointer = 0
End Sub

' 全てのParamArray引数をm_TextSpaceに蓄積する
Public Sub Add(ParamArray Texts() As Variant)

  Dim Text   As Variant
  Dim Length As Long

  ' 引数の文字列を1つずつm_TextSpaceの空白と置換する
  For Each Text In Texts
    ' NullだとLen()でエラーが出るので空の文字列に変える
    If TypeName(Text) = "Null" Then
      Text = ""
    End If
    Length = Len(Text)
    If m_Pointer + Length > m_TextSpaceLengh Then
      ' 文字列領域の容量を超える場合はスペースを大きくする
      ExtendTextSpace m_TextSpaceLengh
    End If
    Mid(m_TextSpace, m_Pointer + 1, Length) = Text
    m_Pointer = m_Pointer + Length
  Next Text

End Sub

' 文字列領域を拡張する
' これまでに蓄積した文字列は保持する
Private Sub ExtendTextSpace(ByRef PlusLengh As Long)

  Dim SavedText As String

  If PlusLengh > 0 Then
    SavedText = Mid(m_TextSpace, 1, m_Pointer)
    m_TextSpaceLengh = m_TextSpaceLengh + PlusLengh
    m_TextSpace = Space(m_TextSpaceLengh)
    Mid(m_TextSpace, 1) = SavedText
  End If

End Sub

このTextSystemクラスは、String型のプライベート変数にある大きさのスペース(空白)で埋まった文字列領域を確保しておいて、Add()メソッドの引数の文字列を文字列領域のスペースと置換して文字列結合を行います。

他のモジュールからTextSystemを使うには次のようにします。

Sub Test_TextSystem()

  Dim TextSystem As TextSystem
  dim JoinedText as String
  Set TextSystem = New TextSystem ' オブジェクト生成
  TextSystem.Add "abc", "def"
  JoinedText = TextSystem.Text
  Debug.Print JoinedText 
  Set TextSystem = Nothing ' メモリ解放
End Sub

TextSystemクラスのデモ

AddメソッドはParamArray引数をとるので、結合したい文字列か変数をカンマ区切りで無数に並べられます。

' SQLのINSERT文を成形する
Sub CreateSqLInsertStatement()

  Dim SQLStatement As TextSystem
  Dim TableName  As String
  Dim FieldName1 As String
  Dim FieldName2 As String
  Dim Value1     As String
  Dim Value2     As String

  Set SQLStatement = New TextSystem
  
  TableName = "レース詳細"
  FieldName1 = "開催月日"
  FieldName2 = "競馬場コード"
  Value1 = "0717"
  Value2 = "05"  ' 東京競馬場
  
  SQLStatement.Add "insert into ", TableName, " (", FieldName1, ", ", FieldName2, ") values ('", Value1, "', '", Value2, "');"
  Debug.Print SQLStatement.Text

  Set SQLStatement = Nothing
End Sub
insert into レース詳細 (開催月日, 競馬場コード) values ('0717', '05');

このTextSystemクラスは使い勝手もいいし、文字列結合が高速なので、とても役に立っています。

このTextSytemクラスのようなプロジェクトのメインクラスをサポートするクラスを作りつつ、JVData To SQLiteシステム全体をざっと作っています。

2017-08-03 オブジェクトの宣言、生成、消去について補足

プロシージャの最後にSet obj = Nothingを書いていませんでした。あと、オブジェクトの宣言と生成をDim obj as New Class1として、同時に行っていました。

このクラスに限らず、Excel VBAでクラスモジュールを作成して、オブジェクトを生成して使用するなら、

' オブジェクト型宣言
Dim obj as Class1
' オブジェクト生成
Set obj = New Class1
' ---
' 何かしらの処理
' ---
' オブジェクト消去(メモリ解放)
Set obj = Nothing

のように、宣言、生成、消去を明記したほうがよいことがわかりました。

' 宣言と生成
Dim obj as New Class1

のように、1文でオブジェクトの宣言と生成ができるのですが、1文で2つの役割を持たせるのはあまりよい方法ではありません[1]

さらに良くないのは、

Set obj = Nothing

を明記しないことでした。

プロシージャの呼び出しが終われば、クラスは自動でターミネイト処理がされるので(Class_Terminate()メソッドがコールされる)、オブジェクト消去のコードを書かなくてもよいと思っていたのですが、これだとメモリがリリースされないことがわかりました。

大量のテキストを扱っていると、どんどんメモリが消費されて、1GBを超えたあたりで「実行時エラー14 文字列領域が不足しています。」が生じます。

ちなみに、Setを書き忘れると、「実行時エラー424 オブジェクトが必要です。」のエラーが生じます。初めてこのエラーが出たときはSetの書き忘れを見つけるのに時間かかりました…

2017-08-31 Qiitaに改良バージョンのコードを寄稿しました。

Clear()をなくして、あらたにReset()を追加しました。Clear()Space()で文字列領域の再確保をしているのですが、これは必要ないし、あると余計に時間がかかるだけなので排除しました。Reset()はポインタを0に初期化しているだけなので時間がかかりません。下記のQiitaにのせたコードの方が改良してあります。

大量の文字列結合を高速処理できるMidステートメントを使ったクラス - Qiita


  1. CODE COMPLETE 第2版 上 完全なプログラミングを目指して (2005年出版 Steve McConnell著)より ↩︎

Kosuke Maeda / まえだこうすけ

「機械学習で競馬予想して勝てるのか?」をテーマに活動中! QiitaにはR、VBAなどのTipsを投稿しています。