はじめに
VBAで大量の文字列を効率的に連結する必要があったため、Midステートメントを活用したStringBuilderクラスを作成しました。通常の文字列連結(&)と比較して、大幅なパフォーマンス向上を実現できます。
ちなみにMidステートメントとは左辺にMidを用いた値の代入のことで、文字列の一部分だけを置き換えることのできる特殊な仕様を指します。
StringBuilderクラス
Option Explicit
'******************************************************************************
' クラス名 : clsStringBuilder
' 機能 : 予め指定したメモリ領域をバッファとして利用する文字列連結クラス
' 説明 : VBA標準の文字列連結(&)は大規模テキストで非効率なため
' : StringBuilderパターンを採用
' 注意点 : 文字数の上限は約5.36億桁（Midステートメントの限界が約1GBのため）
' バージョン: 1.0.0
' -----------------------------------------------------------------------------
' 履歴 : 2025/09/27 pecorimaru Ver.1.0.0 新規作成
'******************************************************************************
'******************************************************************************
' バッファサイズ設定
' ※1文字あたり2バイトであるため、実際に占有するメモリ領域はバッファサイズ*2
'******************************************************************************
Private Const DEFAULT_BUFFER_SIZE As Long = 32768
Private Const GROWTH_FACTOR As Double = 2# ' バッファ拡張倍率
'******************************************************************************
' モジュール名
'******************************************************************************
Private Const CLASS_NAME = "clsStringBuilder"
'******************************************************************************
' エラー番号
'******************************************************************************
Private Const ERR_NO_INDEX_NEGATIVE = vbObjectError + 1001
Private Const ERR_NO_INDEX_OUT_OF_RANGE = vbObjectError + 1002
Private Const ERR_NO_DELETE_LENGTH_NEGATIVE = vbObjectError + 1003
'******************************************************************************
' エラーメッセージ
'******************************************************************************
Private Const ERR_MSG_INDEX_NEGATIVE = "{0}位置が負の値です"
Private Const ERR_MSG_INDEX_OUT_OF_RANGE = "{0}位置（{1}）は範囲外です（可能範囲:0-{2}）"
Private Const ERR_MSG_DELETE_LENGTH_NEGATIVE = "削除文字数が負の値です"
Private Const ERR_MSG_BUFFER_OVERFLOW = "clsStringBuilderのバッファがサイズ制限を超えた可能性があります。" & vbLf & _
"（現在:{0}桁, 上限:約5.36億桁）"
'******************************************************************************
' クラス変数
'******************************************************************************
Private p_buf As String
Private p_currentLength As Long
Private p_bufferSizeOverCount As Long
'******************************************************************************
' 機 能 : クラスの初期化処理
'******************************************************************************
Private Sub Class_Initialize()
p_buf = String$(DEFAULT_BUFFER_SIZE, vbNullChar)
p_currentLength = 0
p_bufferSizeOverCount = 0
End Sub
'******************************************************************************
' 機 能 : クラスの終了処理
'******************************************************************************
Private Sub Class_Terminate()
If p_bufferSizeOverCount > 0 Then
Debug.Print "バッファサイズ超過回数：" + CStr(p_bufferSizeOverCount) + "回"
Debug.Print "最終文字数/バッファサイズ：" + CStr(Me.Length) + "/" + CStr(Me.Capacity)
End If
Call Dispose
End Sub
'******************************************************************************
' 機 能 : 現在の文字数を取得
'******************************************************************************
Public Property Get Length() As Long
Length = p_currentLength
End Property
'******************************************************************************
' 機 能 : 現在のバッファサイズを取得
'******************************************************************************
Public Property Get Capacity() As Long
Capacity = Len(p_buf)
End Property
'******************************************************************************
' 機 能 : バッファが空かどうかを判定
'******************************************************************************
Public Property Get IsEmpty() As Boolean
IsEmpty = (p_currentLength = 0)
End Property
'******************************************************************************
' 機 能 : 全体の文字列を取得（Textプロパティ）
'******************************************************************************
Public Property Get Text() As String
Text = Me.ToString()
End Property
'******************************************************************************
' 機 能 : 文字列をバッファに追加
' -----------------------------------------------------------------------------
' 引 数 : str - 追加する文字列
' 戻り値 : なし
'******************************************************************************
Public Sub Append(ByVal str As String)
If str = "" Then
Exit Sub
End If
Dim strLength As Long
strLength = Len(str)
Call EnsureCapacity(strLength)
On Error GoTo ErrorHandler
' 末尾に文字列をセット
Mid(p_buf, p_currentLength + 1) = str
p_currentLength = p_currentLength + strLength
Exit Sub
ErrorHandler:
Err.Raise Err.Number, CLASS_NAME & ".Append", _
Err.Description & vbLf & FormatMessage(ERR_MSG_BUFFER_OVERFLOW, p_currentLength + strLength)
End Sub
'******************************************************************************
' 機 能 : バッファ内の全文字列を取得
' -----------------------------------------------------------------------------
' 引 数 : なし
' 戻り値 : String - バッファ内の全文字列（空の場合は空文字列）
'******************************************************************************
Public Function ToString() As String
ToString = Left$(p_buf, p_currentLength)
End Function
'******************************************************************************
' 機 能 : 文字列と改行をバッファに追加
' 説 明 : 追加する文字列が省略された場合は改行のみを追加する
' -----------------------------------------------------------------------------
' 引 数 : str - 追加する文字列（省略可能）
' 戻り値 : なし
'******************************************************************************
Public Sub AppendLine(Optional ByVal str As String = "")
Call Me.Append(str)
Call Me.Append(vbCrLf)
End Sub
'******************************************************************************
' 機 能 : バッファの内容をクリア
' -----------------------------------------------------------------------------
' 引 数 : なし
' 戻り値 : なし
'******************************************************************************
Public Sub Clear()
p_buf = String$(DEFAULT_BUFFER_SIZE, vbNullChar)
p_currentLength = 0
End Sub
'******************************************************************************
' 機 能 : 指定位置に文字列を挿入
' -----------------------------------------------------------------------------
' 引 数 : offset - 挿入位置（0ベース）
' : str - 挿入する文字列
' 戻り値 : なし
'******************************************************************************
Public Sub Insert(ByVal offset As Long, ByVal str As String)
' 挿入位置の負数チェック
If offset < 0 Then
Err.Raise ERR_NO_INDEX_NEGATIVE, CLASS_NAME, FormatMessage(ERR_MSG_INDEX_NEGATIVE, "挿入")
End If
' 挿入位置の範囲チェック
If offset > p_currentLength Then
Err.Raise ERR_NO_INDEX_OUT_OF_RANGE, CLASS_NAME, _
FormatMessage(ERR_MSG_INDEX_OUT_OF_RANGE, "挿入", offset, p_currentLength)
End If
' 挿入位置が末尾の場合はAppendを使用
If offset = p_currentLength Then
Call Me.Append(str)
Exit Sub
End If
If str = "" Then
Exit Sub
End If
Dim strLength As Long
strLength = Len(str)
Call EnsureCapacity(strLength)
On Error GoTo ErrorHandler
' 挿入位置以降の文字列を挿入する文字数分シフトする
Mid(p_buf, offset + 1 + strLength) = Mid$(p_buf, offset + 1)
' 挿入位置に文字列をセット
Mid(p_buf, offset + 1) = str
p_currentLength = p_currentLength + strLength
Exit Sub
ErrorHandler:
Err.Raise Err.Number, CLASS_NAME & ".Insert", _
Err.Description & vbLf & FormatMessage(ERR_MSG_BUFFER_OVERFLOW, p_currentLength + strLength)
End Sub
'******************************************************************************
' 機 能 : 指定範囲の文字列を削除
' -----------------------------------------------------------------------------
' 引 数 : start - 削除開始位置（0ベース）
' : removeLength - 削除する文字数
' 戻り値 : なし
'******************************************************************************
Public Sub Remove(ByVal start As Long, ByVal removeLength As Long)
' 削除開始位置の負数チェック
If start < 0 Then
Err.Raise ERR_NO_INDEX_NEGATIVE, CLASS_NAME, FormatMessage(ERR_MSG_INDEX_NEGATIVE, "削除開始")
End If
' 削除開始位置の範囲チェック
If start >= p_currentLength Then
Err.Raise ERR_NO_INDEX_OUT_OF_RANGE, CLASS_NAME, _
FormatMessage(ERR_MSG_INDEX_OUT_OF_RANGE, "削除開始", start, p_currentLength - 1)
End If
' 削除文字数の負数チェック
If removeLength < 0 Then
Err.Raise ERR_NO_DELETE_LENGTH_NEGATIVE, CLASS_NAME, ERR_MSG_DELETE_LENGTH_NEGATIVE
End If
If removeLength = 0 Then
Exit Sub
End If
' 削除範囲を調整（バッファサイズを超えないように）
Dim actualLength As Long
If start + removeLength > p_currentLength Then
actualLength = p_currentLength - start
Else
actualLength = removeLength
End If
' 削除開始位置 + 削除する文字数以降の文字列を削除開始位置へシフトする
Mid(p_buf, start + 1) = Mid$(p_buf, start + actualLength + 1)
' バッファ内の全文字数 - 削除する文字数以降の文字列をクリアする
Mid(p_buf, p_currentLength - actualLength + 1) = String$(removeLength, vbNullChar)
p_currentLength = p_currentLength - actualLength
End Sub
'******************************************************************************
' 機 能 : バッファサイズの拡張
' 説 明 : バッファサイズを超過した場合はサイズを拡張して再配置する
' : -- サイズの拡張方法 --
' : 現在のバッファサイズ + (初期バッファサイズ * 超過回数 * 拡張倍率) + 追加文字数
' -----------------------------------------------------------------------------------
' 引 数 : strLength - 追加文字数
' 戻り値 : なし
'******************************************************************************
Private Sub EnsureCapacity(ByVal strLength As Long)
If p_currentLength + strLength > Len(p_buf) Then
p_bufferSizeOverCount = p_bufferSizeOverCount + 1
p_buf = p_buf & String$(CLng(DEFAULT_BUFFER_SIZE * p_bufferSizeOverCount * GROWTH_FACTOR) + strLength, vbNullChar)
End If
End Sub
'******************************************************************************
' 機 能 : リソースの解放処理
' -----------------------------------------------------------------------------
' 引 数 : なし
' 戻り値 : なし
'******************************************************************************
Private Sub Dispose()
p_buf = vbNullString
p_currentLength = 0
p_bufferSizeOverCount = 0
End Sub
'******************************************************************************
' 機 能 : プレースホルダーを置き換えた文字列を取得
' 説 明 : テンプレート文字列内の{0},{1}...を指定された値で置き換える
' 注意事項 : ・プレースホルダーは{0}から開始（0ベース）
' : ・引数が不足した場合、該当プレースホルダーはそのまま残る
' -----------------------------------------------------------------------------
' 引 数 : template - テンプレート文字列
' : args - 置き換える値（可変引数）
' 戻り値 : String - 置き換え後の文字列
'******************************************************************************
Private Function FormatMessage( _
ByVal template As String, _
ParamArray args() As Variant _
) As String
Dim result As String
Dim i As Integer
result = template
' 各引数でプレースホルダーを置換
For i = 0 To UBound(args)
result = Replace(result, "{" & CStr(i) & "}", CStr(args(i)))
Next i
FormatMessage = result
End Function
制限事項
| 項目 | 制限値 | 理由 |
|---|---|---|
| 最大文字数 | 約5.36億文字 | Midステートメントの限界 |
| メモリ使用量 | 約1GB | UTF-16エンコーディング |
| Insert/Remove | 低パフォーマンス | 文字列シフト処理のため |
Insert、Removeは大量データで使用するとパフォーマンスが大幅に低下します。
基本的にはAppend中心の使用を推奨します。
使い方
Public Sub test()
Dim sb As New clsStringBuilder
sb.Append "Append"
sb.AppendLine "Remove"
sb.AppendLine "AppendLine"
sb.Insert 6, "Insert"
sb.Remove 12, 6
Debug.Print "Length:" & sb.Length
Debug.Print "Capacity:" & sb.Capacity
Debug.Print "IsEmpty:" & sb.IsEmpty
Debug.Print sb.ToString
sb.Clear
Debug.Print "Length:" & sb.Length
Debug.Print "Capacity:" & sb.Capacity
Debug.Print "IsEmpty:" & sb.IsEmpty
Debug.Print sb.ToString
End Sub
## 実行結果 ##
Length:26
Capacity:32768
IsEmpty:False
AppendInsert
AppendLine
Length:0
Capacity:32768
IsEmpty:True
パフォーマンスチェック
実施環境
- Windows 11, Ryzen 7 255（AMD Ryzen 9 8945H相当？）, 32GB RAM
- Microsoft 365 (64bit)
' 3万文字*20列*884行(約5.3億文字)の処理時間を計測
Sub TestPrcsTime()
Dim startTime As Double
startTime = Timer
Dim sb As New clsStringBuilder
Dim ary As Variant
ary = ActiveSheet.Range("A1:U884")
Dim i As Long
For i = LBound(ary, 1) To UBound(ary, 1)
Dim j As Long
For j = LBound(ary, 2) To UBound(ary, 2)
sb.Append CStr(ary(i, j))
Next
Next
Dim str As String
str = sb.ToString
Dim endTime As Double
endTime = Timer
Call PrintPrcsTime(startTime, endTime)
End Sub
' 5文字*106列*1,000,000行(5.3億文字)の処理時間を計測
Sub TestPrcsTime2()
Dim startTime As Double
startTime = Timer
Dim sb As New clsStringBuilder
Dim ary As Variant
ary = ActiveSheet.Range("A1:DB1000000")
Dim i As Long
For i = LBound(ary, 1) To UBound(ary, 1)
Dim j As Long
For j = LBound(ary, 2) To UBound(ary, 2)
sb.Append CStr(ary(i, j))
Next
Next
Dim str As String
str = sb.ToString
Dim endTime As Double
endTime = Timer
Call PrintPrcsTime(startTime, endTime)
End Sub
Public Sub PrintPrcsTime(ByVal startTime As Double, ByVal endTime As Double)
Dim elapsed As Double
elapsed = endTime - startTime
Dim mm As Long
mm = Int(elapsed \ 60)
Dim ss As Long
ss = Int(elapsed Mod 60)
Dim ms As Long
ms = (elapsed - Int(elapsed)) * 1000
' フォーマットして出力
Debug.Print "処理時間：" & Format(mm, "00") & ":" & Format(ss, "00") & ":" & Format(ms, "000")
End Sub
# TestPrcsTime(3万文字*20列*884行(約5.3億文字)の処理時間を計測)
処理時間：00:24:277
バッファサイズ超過回数：127回
最終文字数/バッファサイズ：530400000/536519376
# TestPrcsTime2（5文字*106列*1,000,000行(5.3億文字)の処理時間を計測）
処理時間：02:00:676
バッファサイズ超過回数：127回
最終文字数/バッファサイズ：530000000/532710011
旧世代PCでも確認
- Windows 11, Core i5 3340M(Ivy Bridge), 8GB RAM
- Microsoft 365 (64bit)
# TestPrcsTime(3万文字*20列*884行(約5.3億文字)の処理時間を計測)
処理時間：00:41:068
バッファサイズ超過回数：127回
最終文字数/バッファサイズ：530400000/536519376
# TestPrcsTime2（5文字*106列*1,000,000行(5.3億文字)の処理時間を計測）
処理時間：02:36:922
バッファサイズ超過回数：127回
最終文字数/バッファサイズ：530000000/532710011
パフォーマンスチェックを再現する場合は文字列をセットしたExcelシートを準備する必要があります。
Insert、RemoveはAppendの1/10以下のパフォーマンスであり、多用するとクラッシュする可能性が高いためご注意ください。
例えば、TestPrcsTimeをInsertで実施する場合だと、行数を100行に減らした結果が次の通りです。
' 3万文字*20列*100行(約6千万文字)の処理時間を計測
Sub TestPrcsTime()
Dim startTime As Double
startTime = Timer
Dim sb As New clsStringBuilder
Dim ary As Variant
ary = ActiveSheet.Range("A1:U100")
Dim i As Long
For i = LBound(ary, 1) To UBound(ary, 1)
Dim j As Long
For j = LBound(ary, 2) To UBound(ary, 2)
sb.Insert 0， CStr(ary(i, j))
Next
Next
Dim str As String
str = sb.ToString
Dim endTime As Double
endTime = Timer
Call PrintPrcsTime(startTime, endTime)
End Sub
# TestPrcsTime
処理時間：01:49:781
バッファサイズ超過回数：42回
最終文字数/バッファサイズ：60000000/60471776
最終文字数/バッファサイズ：60000000/60471776
処理の説明（コア部分のみ）
クラスの初期化処理(Class_Initialize)
' 全体
Private Sub Class_Initialize()
p_buf = String$(DEFAULT_BUFFER_SIZE, vbNullChar)
p_currentLength = 0
p_bufferSizeOverCount = 0
End Sub
' バッファの初期化処理
p_buf = String$(DEFAULT_BUFFER_SIZE, vbNullChar)
- [DEFAULT_BUFFER_SIZE]で指定した桁数分のNull文字をセットしています
- 「$」には次の意味があり、パフォーマンス向上のために付けています
- String：Variant型を返す
- String$：String型を返す
文字列をバッファに追加(Append)
' 全体
Public Sub Append(ByVal str As String)
If str = "" Then
Exit Sub
End If
Dim strLength As Long
strLength = Len(str)
Call EnsureCapacity(strLength)
On Error GoTo ErrorHandler
' 末尾に文字列をセット
Mid(p_buf, p_currentLength + 1) = str
p_currentLength = p_currentLength + strLength
Exit Sub
ErrorHandler:
Err.Raise Err.Number, CLASS_NAME & ".Append", _
Err.Description & vbLf & FormatMessage(ERR_MSG_BUFFER_OVERFLOW, p_currentLength + strLength)
End Sub
ポイント
' 末尾に文字列をセット
Mid(p_buf, p_currentLength + 1) = str
# 処理イメージ
0. 前提
p_buf = "--------------------..." ※-はNull値
str = "ABC"
1. 末尾に文字列(ABC)をセット
before：--------------------...
after ：ABC-----------------...
エラーハンドリング
Midステートメントは約5.36億文字を超えると例外が発生するため、clsStringBuilderの中で発生したエラーと認識できるようなエラーハンドリングを実装しています。
' 末尾に文字列をセット（第３引数でstrLengthを指定）
Mid(p_buf, p_currentLength + 1, strLength) = str
- 上記のように第３引数を指定するのは冗長と考え省略しました
※strLength = 3万の場合でもパフォーマンスに違いは見られませんでした
指定位置に文字列を挿入(Insert)
' 全体
Public Sub Insert(ByVal offset As Long, ByVal str As String)
' 挿入位置の負数チェック
If offset < 0 Then
Err.Raise ERR_NO_INDEX_NEGATIVE, CLASS_NAME, FormatMessage(ERR_MSG_INDEX_NEGATIVE, "挿入")
End If
' 挿入位置の範囲チェック
If offset > p_currentLength Then
Err.Raise ERR_NO_INDEX_OUT_OF_RANGE, CLASS_NAME, _
FormatMessage(ERR_MSG_INDEX_OUT_OF_RANGE, "挿入", offset, p_currentLength)
End If
' 挿入位置が末尾の場合はAppendを使用
If offset = p_currentLength Then
Call Me.Append(str)
Exit Sub
End If
If str = "" Then
Exit Sub
End If
Dim strLength As Long
strLength = Len(str)
Call EnsureCapacity(strLength)
On Error GoTo ErrorHandler
' 挿入位置以降の文字列を挿入する文字数分シフトする
Mid(p_buf, offset + 1 + strLength) = Mid$(p_buf, offset + 1)
' 挿入位置に文字列をセット
Mid(p_buf, offset + 1) = str
p_currentLength = p_currentLength + strLength
Exit Sub
ErrorHandler:
Err.Raise Err.Number, CLASS_NAME & ".Insert", _
Err.Description & vbLf & FormatMessage(ERR_MSG_BUFFER_OVERFLOW, p_currentLength + strLength)
End Sub
ポイント
' 挿入位置以降の文字列を挿入する文字数分シフトする
Mid(p_buf, offset + 1 + strLength) = Mid$(p_buf, offset + 1)
' 挿入位置に文字列をセット
Mid(p_buf, offset + 1) = str
# イメージ
0. 前提
p_buf = "ABCDEF--------------..." ※-はNull値
offset = 3
str = "INSERT"
1. 挿入位置以降の文字列を挿入する文字数分シフトする
before：ABCDEF--------------...
after ：ABCDEF---DEF--------...
2. 挿入位置に文字列をセット
before：ABCDEF---DEF--------...
after ：ABCINSERTDEF--------...
指定範囲の文字列を削除(Remove)
' 全体
Public Sub Remove(ByVal start As Long, ByVal removeLength As Long)
' 削除開始位置の負数チェック
If start < 0 Then
Err.Raise ERR_NO_INDEX_NEGATIVE, CLASS_NAME, FormatMessage(ERR_MSG_INDEX_NEGATIVE, "削除開始")
End If
' 削除開始位置の範囲チェック
If start >= p_currentLength Then
Err.Raise ERR_NO_INDEX_OUT_OF_RANGE, CLASS_NAME, _
FormatMessage(ERR_MSG_INDEX_OUT_OF_RANGE, "削除開始", start, p_currentLength - 1)
End If
' 削除文字数の負数チェック
If removeLength < 0 Then
Err.Raise ERR_NO_DELETE_LENGTH_NEGATIVE, CLASS_NAME, ERR_MSG_DELETE_LENGTH_NEGATIVE
End If
If removeLength = 0 Then
Exit Sub
End If
' 削除範囲を調整（バッファサイズを超えないように）
Dim actualLength As Long
If start + removeLength > p_currentLength Then
actualLength = p_currentLength - start
Else
actualLength = removeLength
End If
' 削除開始位置 + 削除する文字数以降の文字列を削除開始位置へシフトする
Mid(p_buf, start + 1) = Mid$(p_buf, start + actualLength + 1)
' バッファ内の全文字数 - 削除する文字数以降の文字列をクリアする
Mid(p_buf, p_currentLength - actualLength + 1) = String$(removeLength, vbNullChar)
p_currentLength = p_currentLength - actualLength
End Sub
ポイント
' 削除開始位置 + 削除する文字数以降の文字列を削除開始位置へシフトする
Mid(p_buf, start + 1) = Mid$(p_buf, start + actualLength + 1)
' バッファ内の全文字数 - 削除する文字数以降の文字列をクリアする
Mid(p_buf, p_currentLength - actualLength + 1) = String$(removeLength, vbNullChar)
# イメージ
0. 前提
p_buf = "ABCDEF--------------..." ※-はNull値
start = 1
removeLength = 3
1. 削除開始位置 + 削除する文字数以降の文字列を削除開始位置へシフトする
before：ABCDEF--------------...
after ：AEFDEF--------------...
2. バッファ内の全文字数 - 削除する文字数以降の文字列をクリアする
before：AEFDEF--------------...
after ：AEF-----------------...
バッファサイズの拡張(EnsureCapacity)
' 全体
Private Sub EnsureCapacity(ByVal strLength As Long)
If p_currentLength + strLength > Len(p_buf) Then
p_bufferSizeOverCount = p_bufferSizeOverCount + 1
p_buf = p_buf & String$(CLng(DEFAULT_BUFFER_SIZE * p_bufferSizeOverCount * GROWTH_FACTOR) + strLength, vbNullChar)
End If
End Sub
ポイント
p_buf = p_buf & String$(CLng(DEFAULT_BUFFER_SIZE * p_bufferSizeOverCount * GROWTH_FACTOR) + strLengthgth, vbNullChar)
やや面倒な計算式になっていますが、イメージは下記のとおりで、
バッファが超過した回数分、追加するバッファを増やす仕様としております。
# イメージ
0. 前提
strLength は軽微な桁数と仮定し、イメージから省略する
□ = 値がNull値のバッファ
■ = 値が文字列のバッファ
※ □ or ■ が１つあたり、初期バッファサイズ（DEFAULT_BUFFER_SIZE）とする
1. 超過1回目
before：■
after ：■ □ □
2. 超過2回目
before：■ ■ ■
after ：■ ■ ■ □ □ □ □
3. 超過3回目
before：■ ■ ■ ■ ■ ■ ■
after ：■ ■ ■ ■ ■ ■ ■ □ □ □ □ □ □
※実際のafterは上記 +strLength 分が拡張される
バッファサイズの拡張処理は初期バッファサイズや拡張量が少ないと頻繁にリサイズが発生してパフォーマンスが落ちてしまいますが、逆に拡張しすぎてもリソースの無駄遣いになるため、両者のバランスを考えて設定する必要があります。
上記を踏まえた上でも、今の仕組みはそこそこバランスが取れた実装になっていると思います。
例えば、パフォーマンスチェックの項で記載した、TestPrcsTimeとTestPrcsTime2を5億桁の初期バッファサイズで実施した場合の結果は次の通りです。
Private Const DEFAULT_BUFFER_SIZE As Long = 536519376 の場合
# TestPrcsTime
処理時間：00:03:555
# TestPrcsTime2
処理時間：01:32:219
Private Const DEFAULT_BUFFER_SIZE As Long = 32768 の場合
# TestPrcsTime(3万文字*20列*884行(約5.3億文字)の処理時間を計測)
処理時間：00:24:277
# TestPrcsTime2（5文字*106列*1,000,000行(5.3億文字)の処理時間を計測）
処理時間：02:00:676
限界値である5億桁を格納する機会はあまりないと思いますが、超過回数に対するパフォーマンスの減衰幅はこの通りです。利用ケースに合わせて初期バッファサイズを調整するのがベターな使い方ではないでしょうか。
まとめ
VBAの文字列結合は頻繁に使用することがあるので一度時間をとって手堅いものを作ろうと思い着手しましたが、記事作成時点でもいろいろと修正したこともあって時間がかかってしまいました。
そんな苦労もあってなかなか無駄のない実装ができたと思っているので、同じ課題を抱える方のお役に立てれば幸いです。