aodama.gif(0.97KB) 文字列の置き換えをする(Replace)

 VB5 以前の VB には、文字列置換ができる関数は存在しないため、 自作するしかありません。拙作の StrReplace 関数は、文字列の置換を行うことができる関数です。 VB6 をお使いの方は Replace 関数があるので、 わざわざこの関数を使う必要はありません。VB4, VB5 ユーザー用です(^^;

 文字列置換のサンプルはすでに色んなところで公開されているのですが、 それらの処理速度に不満があったので自分で作ってみました。 引数を VB6 の Replace 関数と同じにしていますので、 今後 VB6 に移行した場合でもスムーズに移行できると思います。

※以下のサンプルは、VB5 用です。VB4 の方はこちらをお使い下さい。

Option Explicit

'置き換え結果一時格納場所のサイズが予約サイズを超えてしまった場合に
'追加するバッファのサイズ。値を増やせば処理速度は向上しますが、
'メモリを食います。(32767で約64KBずつ使用)
Public Const ADD_SIZE = 32767

'----- StrReplace 関数 Ver 1.05 -----
'(C)2000 けるべ
'MAIL : NULL
'HOME : http://www.geocities.co.jp/SilkRoad/4511/
'
'指定された文字列の中にある特定の文字列を、指定した文字列に
'置き換える関数です。
'Ver 1.05 より、仕様を変更しました。(オプション追加)
'Ver 1.04 以前のバージョンから使用されている方はご注意下さい。
'
'引数 strExp
'   置換する文字列を含む文字列を指定します。
'
'引数 strFind
'   検索する文字列を指定します。
'
'引数 strRep
'   置換する文字列を指定します。
'
'引数 lngStart
'   省略可能です。引数 strExp 内の内部文字列の検索開始位置を
'   指定します。この引数を省略すると、1 が使用されます。
'
'引数 lngCount
'   省略可能です。置換する文字列数を指定します。この引数を省略すると、
'   既定値の -1 が使用され、すべての候補が置換されます。
'
'引数 lngComp
'   省略可能です。文字列式を評価するときに使用する文字列比較の
'   モードを表す数値を指定します。
'   vbBinaryCompare - バイナリ モードで比較を行います。(0)
'                     大文字小文字を区別します。
'   vbTextCompare   - テキスト モードで比較を行います。(1)
'                     大文字小文字を区別しません。
'   引数 lngComp を省略すると、バイナリ モードで比較が行われます。
'
'戻り値
'   strExp 文字列中の strFind 文字列を、strRep に置き換えた文字列が
'   返ります。
'
Public Function StrReplace _
    (ByRef strExp As String, _
     ByRef strFind As String, _
     ByRef strRep As String, _
     Optional ByVal lngStart As Long = 1, _
     Optional ByVal lngCount As Long = -1, _
     Optional ByVal lngComp As Long = vbBinaryCompare) As String

 Dim strBuffer As String  '置き換え結果一時格納バッファ
 Dim lngPos2 As Long      'InStr 関数用文字検出位置
 Dim lngMidSize As Long   'Mid$ 関数で抜き出される文字数
 Dim lngTotalSize As Long '置き換え開始ポインタ
 Dim lngExpLen As Long    '置き換えの対象となる文字列のサイズ
 Dim lngFindLen As Long   '検索される文字列のサイズ
 Dim lngRepLen As Long    '置き換えされる文字列のサイズ
 Dim lngBufSize As Long   '予約された文字列のサイズ
 Dim lngMargin As Long    '予約バッファサイズと置換サイズの差
 Dim lngRepCnt As Long    '置き換えを行った回数
 
    lngExpLen = Len(strExp)                 'strExp のサイズを得る
    lngFindLen = Len(strFind)               'strFind のサイズを得る
    lngRepLen = Len(strRep)                 'strRep のサイズを得る
    If lngExpLen = 0 Or lngFindLen = 0 Then 'strExp または strFind がサイズ 0 だった場合
        StrReplace = strExp                 '何も置換せずに関数を抜ける
        Exit Function
    End If
    
    If lngFindLen < lngRepLen Then              'strRep の文字数が strFind より大きい場合
        lngBufSize = lngExpLen + ADD_SIZE       'バッファサイズを strExp より ADD_SIZE 多く確保
    Else
        lngBufSize = lngExpLen
    End If
    strBuffer = String$(lngBufSize, vbNullChar) 'strBuffer を NULL 文字で埋める

    If lngStart <= lngExpLen Then                                         '正しい検索開始点が設定されている場合
        If lngStart <> 1 Then
            Mid(strBuffer, 1, lngStart - 1) = Left$(strExp, lngStart - 1) '検索開始点より前の文字列をバッファにコピー
        End If
        lngTotalSize = lngStart
    Else                                                                  '正しい検索開始点が設定されていない場合
        StrReplace = strExp                                               '何も置換せずに関数を抜ける
        Exit Function
    End If
    
    Do
        lngPos2 = InStr(lngStart, strExp, strFind, lngComp)                                   '文字を検索し、その位置を返す
        If lngRepCnt = lngCount Then lngPos2 = 0                                              '置換回数が設定回数に達した場合、見つからなかったことにする
        If lngPos2 Then                                                                       '文字が見つかった場合
            lngMidSize = lngPos2 - lngStart                                                   '見つかった文字までのサイズを得る
            If (lngTotalSize + lngMidSize + lngRepLen) > lngBufSize Then                      '次回置換時に予約サイズを超えてしまう場合
                lngMargin = (lngTotalSize + lngMidSize + lngRepLen) - (lngBufSize + ADD_SIZE) '次回置換時に必要なサイズとバッファサイズの差分を得る
                If lngMargin <= 0 Then                                                        'ADD_SIZE 増加するだけで事足りる場合
                    strBuffer = strBuffer + String$(ADD_SIZE, vbNullChar)                     'ADD_SIZE の数だけ NULL を増やす
                    lngBufSize = lngBufSize + ADD_SIZE
                Else                                                                          'ADD_SIZE 増加するだけではサイズが足りない場合
                    strBuffer = strBuffer + String$(lngMargin, vbNullChar)                    'lngMargin の数だけ NULL を増やす
                    lngBufSize = lngBufSize + lngMargin
                End If
            End If
            Mid(strBuffer, lngTotalSize, lngMidSize) = Mid$(strExp, lngStart, lngMidSize)     'strBuffer を lngTotalSize から置き換え
            Mid(strBuffer, lngTotalSize + lngMidSize, lngRepLen) = strRep
            lngStart = lngPos2 + lngFindLen                                                   '次回検索開始点を設定
            lngTotalSize = lngTotalSize + lngMidSize + lngRepLen                              'strBuffer の次回の置き換え開始位置
            lngRepCnt = lngRepCnt + 1
        Else
            lngMidSize = lngExpLen - lngStart + 1
            If (lngTotalSize + lngMidSize + lngRepLen) > lngBufSize Then                      '次回置換時に予約サイズを超えてしまう場合
                lngMargin = (lngTotalSize + lngMidSize + lngRepLen) - (lngBufSize + ADD_SIZE) '次回置換時に必要なサイズとバッファサイズの差分を得る
                If lngMargin <= 0 Then                                                        'ADD_SIZE 増加するだけで事足りる場合
                    strBuffer = strBuffer + String$(ADD_SIZE, vbNullChar)                     'ADD_SIZE の数だけ NULL を増やす
                    lngBufSize = lngBufSize + ADD_SIZE
                Else                                                                          'ADD_SIZE 増加するだけではサイズが足りない場合
                    strBuffer = strBuffer + String$(lngMargin, vbNullChar)                    'lngMargin の数だけ NULL を増やす
                    lngBufSize = lngBufSize + lngMargin
                End If
            End If
            Mid(strBuffer, lngTotalSize, lngMidSize) = Right$(strExp, lngMidSize)             '対象文字列の最後までを抜き出す
            lngTotalSize = lngTotalSize + lngMidSize - 1
        End If
    Loop Until lngPos2 = 0                                                                    '検索文字列が見つからなくなるまでループ

    StrReplace = Left$(strBuffer, lngTotalSize) '置き換え結果を返す

End Function

サンプル : ダウンロード s_rep.lzh(3.63KB)

 ちなみに、色んなところで公開されている文字列置換関数がなぜ遅いのかというと、 大抵のものは文字列連結演算子(&, +)を多用している場合が多いからです。 文字列連結演算子を多用すると、その度にVB内部で文字列用のメモリ確保処理を行うため、 処理速度が非常に遅くなってしまうらしいです。V友とかからの受け売りですが(^^;
 拙作の StrReplace 関数は、最初に充分なメモリ確保を行い、文字列連結演算子の使用を極力抑え、 Mid ステートメントによる文字列の置換でこの問題を解消し、スピードアップしています。

 しかしあらためて見なおしてみると、 「こうすればもう少しスピードアップできるぞ」というツッコミどころ満載ですね。 それに lngPos1 がないのに lngPos2 って変数名を使用してたり(笑)。 また暇があったら書き直してみます(^-^;


aodama.gif(0.97KB) おまけ

 VB で VBScript の RegExp オブジェクトを作成し、Replace メソッドを使用すれば、 正規表現を使用した高度な置換が可能です。 ただし RegExp オブジェクトおよび Replace メソッドは VBScript Version 5.0 以上でしか使用できませんので、 Microsoft Internet Explorer 5.0 などがインストールされていないと使用することが出来ません。

Option Explicit

'----- StrReplaceEx 関数 -----
'正規表現による検索で見つかったテキストを置換します。
'この関数を使用するには、正規表現に関する知識が必要です。
'また正規表現オブジェクト及び Replace メソッドは VBScript 5.0 以降の
'機能ですので、Microsoft Internet Explorer 5.0 以上などが
'インストールされた環境が必要となります。
'
'引数 strExpression
'   置換する文字列を含む文字列を指定します。
'
'引数 strPattern
'   検索する正規表現のパターンを設定します。
'
'引数 strReplaceWith
'   置換する文字列を指定します。
'
'引数 blnIgnoreCase
'   省略可能です。パターン検索で大文字と小文字を区別するかどうかを
'   示す Boolean 値を設定します。
'
'   True  - 大文字小文字を区別しない("i" オプションに相当)
'   False - 大文字小文字を区別する
'
'   省略すると True が使用されます。
'
'引数 blnGlobal
'   省略可能です。索文字列全体についてのパターンとの一致を検索するか、
'   最初の一致だけを検索するかを示す Boolean 値を設定します。
'
'   True  - 文字列全体に検索が適用される("g" オプションに相当)
'   False - 最初に見つかった文字列だけが適用される
'
'   省略すると True が使用されます。
'
'戻り値
'   引数 strExpression に指定した文字列を、引数 strPattern の
'   正規表現にマッチした文字列を引数 strReplaceWith に置換した
'   文字列が返ります。
'
Public Function StrReplaceEx _
    (ByRef strExpression As String, _
     ByRef strPattern As String, _
     ByRef strReplaceWith As String, _
     Optional ByVal blnIgnoreCase As Boolean = True, _
     Optional ByVal blnGlobal As Boolean = True) As String

 Dim objRegExp As Object                                            '正規表現オブジェクト変数の宣言

    Set objRegExp = CreateObject("VBScript.RegExp")                 '正規表現オブジェクトを作成
    
    objRegExp.Pattern = strPattern                                  '検索パターンの設定
    objRegExp.IgnoreCase = blnIgnoreCase                            '大文字小文字区別の設定
    objRegExp.Global = blnGlobal                                    '置換候補の設定
    
    StrReplaceEx = objRegExp.Replace(strExpression, strReplaceWith) 'Replace メソッドで文字列の置換
    
    Set objRegExp = Nothing                                         'オブジェクトの解放

End Function

べたテキスト版 : ダウンロード repex.txt (2.18KB) ※ 右クリックで「対象をファイルに保存(A)」して下さい


VBコーナーにもどる   トップページにもどる