配列内の文字を複数条件で置換 - Infomentのブログ～Excel VBA奮闘記～

文字を置換したい。シート上であれば、これで片が付く。
f:id:Infoment:20190926222437p:plain

だが今回は配列内の文字に対し、複数条件で置換したい。挑戦してみた。
f:id:Infoment:20190926231020p:plain

折角なので、先日来作成しているArrayEditClassの機能拡張で対応してみた。
作戦は、こうだ。

ParamArrayキーワードで、置換前後の文字列を受け取る。
受け取った文字で、配列内を置換（ローラー作戦）。

ということで、手法はとっても原始的。
しばらく捏ね繰り回してみて、できた結果がコチラ。

' 配列内の文字列置き換え。
' 置換前と置換後の文字を列記して、ParamArrayキーワードで配列として受け取る。
' ０，２，４，６・・・番目が置換前
' １，３，５，７・・・番目が置換後
' となる。組合せは（０，１），（２，３）・・・の順。
Public Function MultipleSubstitution(ParamArray str()) As Variant
    ' 置換前と置換後の組合せ数を、配列の最大数÷２から求める。
    ' ※引数が奇数個の場合を想定して、RoundDown関数で切り捨て。
    ' ※その場合、最後に指定した文字はvbNullstringと置換される。
    Dim iMax As Long
        iMax = WorksheetFunction.RoundDown(UBound(str) / 2, 0)
    
    ' 置換前文字。
    Dim msWhat() As Variant
    ReDim msWhat(iMax)
    
    ' 置換後文字。
    Dim msReplacement As Variant
    ReDim msReplacement(iMax)
    
    ' 置換前後の文字を配列に格納する。
    ' ※奇数個指定の場合、最後の置換前文字に対する置換後文字が
    ' 　vbNullStringになるよう、エラーを無視させている。
        On Error Resume Next
        For i = 0 To UBound(str)
            msWhat(i) = str(2 * i)
            msReplacement(i) = str(2 * i + 1)
        Next
        On Error GoTo 0
    
    ' 配列内の全ての文字列に対し、置換処理を行う。
        For r = rMin To rMax
            For c = cMin To cMax
                For i = 0 To iMax
                    source_array(r, c) = Replace(source_array(r, c), _
                                                 msWhat(i), _
                                                 msReplacement(i))
                Next
            Next
        Next
        
        MultipleSubstitution = source_array
End Function

早速、いつもの「なんちゃって個人情報」で試してみよう。
f:id:Infoment:20190926231508p:plain

今回設定した置換条件は、以下のとおり。

ドコモ ⇒ docomo
ソフトバンク ⇒ SoftBank
ツーカー ⇒ 削除

置換したら、新しいシートに貼り付けてテーブルにする。
なお、ツーカーを削除したことに特別な意味はない。あくまでテストってことで。

Sub abe_shi()
    Dim SQC As SeaquenceClass
    Set SQC = New SeaquenceClass
    Dim arr() As Variant
        arr = ActiveSheet.UsedRange.Value
        arr = SQC.TargetArray(arr).MultipleSubstitution("ドコモ", "docomo", _
                                                        "ソフトバンク", "SoftBank", _
                                                        "ツーカー")
        SQC.TargetArray(arr).PasteArray "A1", "NewSheet", ptTable, True
End Sub