マクロ（複数文字置換）についての質問です。

質問

現在、ExcelのA列に置換前の文字、B列に置換後の文字が入っているシート（シート名："辞書"）があります。
そのシートを辞書的役割で使用し別のシートの内容を置換したいと考えています（現在候補が1000文字程度あり、１つずつ置換をすることが難しいです）
また、完全一致のみの置換、大文字とから小文字の置換も可能にし、件数も何件存在するかわかりません。

例：ABCをabcに変換したい場合、
○ABC→abc
×ABCDEF→abcDEF
のような感じです。

しかし、1つのセルの中に空白がある場合は置換可能とします。
例：ABC　DEF→abc　DEF

このようなことは可能でしょうか？
何卒よろしくお願いいたします。

回答No.5

mitarashi

A No.2です。
試行錯誤しているうちに、今回の事例ではSubmatchの必要が無くなっていました。検索パターンの()は不要です。
Private Sub test(srcString As String, replaceString As String)で、
patternString = "\b" & srcString & "\b"

Private Function regExReplace(targetString As String, patternString As String, replaceString As String) As Stringで
regEx.Pattern = Matches(0)
で動きますので、一応お知らせしておきます。

回答No.4

n-jun

>1つのセルの中に空白がある場合
半角スペースの場合としておきます。

Sub　test()
　　Dim　Dic　As　Object
　　Dim　i　As　Long,　j　As　Long
　　Dim　v,　w,　x,　y

　　Set　Dic　=　CreateObject("Scripting.Dictionary")
　　Application.ScreenUpdating　=　False

　　With　Worksheets("Sheet2")　　'　辞書シート
　　　　　　　v　=　.Range(.Range("A1"),　.Cells(Rows.Count,　2).End(xlUp)).Value
　　End　With

　　For　i　=　1　To　UBound(v,　1)
　　　　　　Dic.Add　v(i,　1),　v(i,　2)
　　Next

　　With　Worksheets("Sheet1")　　'　検索シート
　　　　　　　　w　=　.UsedRange.Value

　　　　　　　　ReDim　y(1　To　UBound(w,　1),　1　To　UBound(w,　2))

　　　　　　　　For　i　=　1　To　UBound(w,　1)
　　　　　　　　　　　　For　j　=　1　To　UBound(w,　2)

　　　　　　　　　　　　　　　　x　=　Split(w(i,　j),　"　")　'　半角スペースで区切ってみる
　　　　　　　　　　　　　　　　Select　Case　LenB(w(i,　j))
　　　　　　　　　　　　　　　　　　　　　　　Case　Is　>　0
　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　UBound(x)　=　0　Then
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　If　Dic.exists(x(0))　Then
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　y(i,　j)　=　Dic(x(0))
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Else
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　y(i,　j)　=　w(i,　j)
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　End　If
　　　　　　　　　　　　　　　　　　　　　　　　　　　　ElseIf　Dic.exists(x(0))　Then
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　y(i,　j)　=　Dic(x(0))　&　"　"　&　x(1)
　　　　　　　　　　　　　　　　　　　　　　　　　　　　Else
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　y(i,　j)　=　w(i,　j)
　　　　　　　　　　　　　　　　　　　　　　　　　　　　End　If
　　　　　　　　　　　　　　　　　　　　　　　Case　0
　　　　　　　　　　　　　　　　　　　　　　　　　　　　y(i,　j)　=　Empty
　　　　　　　　　　　　　　　　End　Select
　　　　　　　　　　　　Next
　　　　　　　　Next
　　　　　　　　.Cells.ClearContents
　　　　　　　　.Range("A1").Resize(UBound(y,　1),　UBound(y,　2)).Value　=　y
　　End　With
　　Application.ScreenUpdating　=　True
　　Set　Dic　=　Nothing
　　Erase　v,　w,　x,　y
End　Sub
ご参考まで。

回答No.3

mitarashi

#2です。早速問題が露呈しました。
patternString = "\b(" & srcString & ")\b"
に変更して下さい。前のままでは、ABCDEF -> ABCdefになってしまいました。
お詫びに？、ループを回す部分の概略を載せます。
Sub main()
Dim targetRange As Range
Dim targetRow As Range

'置換対象シートは1番目とする
Set targetRange = Sheets("辞書").Range("a1").CurrentRegion
For Each targetRow In targetRange.Rows
Call test(targetRow.Cells(1), targetRow.Cells(2))
Next
End Sub

回答No.2

mitarashi

久しぶりの正規表現。気楽に始めたら、手こずってしまいました。対照表から読み取ってループを回す部分は、ご自分でお願いします。
単純なデータでしか試験してないので、うまく動かなかったらあしからず。冗長なコードや、変な英語はご笑納下さい。
Sub main()
Call test("ABC", "abc")
End Sub

Private Sub test(srcString As String, replaceString As String)
Dim patternString As String
Dim findRange As Range, firstAddress As String

patternString = "(" & srcString & ")\b"
With Worksheets(1).UsedRange
Set findRange = .Find(srcString, LookIn:=xlValues, LookAt:=xlPart)
If Not findRange Is Nothing Then
firstAddress = findRange.Address
Do
findRange.Value = regExReplace(findRange.Value, patternString, replaceString)
Set findRange = .FindNext(findRange)
Loop While Not findRange Is Nothing And findRange.Address <> firstAddress
End If
End With
End Sub

Private Function regExReplace(targetString As String, patternString As String, replaceString As String) As String
Dim regEx As Variant
Dim Matches As Object, Match As Object

Set regEx = CreateObject("VBScript.RegExp")
regEx.MultiLine = False
regEx.Pattern = patternString
regEx.IgnoreCase = False
regEx.Global = False
Set Matches = regEx.Execute(targetString)
If Matches.Count > 0 Then
regEx.Pattern = Matches(0).submatches.Item(0)
regExReplace = regEx.Replace(targetString, replaceString)
Else
regExReplace = targetString
End If
Set regEx = Nothing
End Function
詳細は、「VBA　正規表現」で検索してお調べ下さい。

回答No.1

n-jun

＞そのシートを辞書的役割で使用し別のシートの内容を置換したいと考えています
辞書的なシートのレイアウトと別シートのレイアウトを提示されては？

補足

確かにそのとおりですね。
ご指摘ありがとうございます。

辞書的なシートのレイアウトは、Ａ列に置換前の文字列、Ｂ列に置換後の文字列が入力されています。
例：Ａ列　｜Ｂ列
　－－－－－－－－－－
　　ABC 　｜abc
のような感じです。
また、別シートのレイアウトは、全部のセルを対象範囲としております。

よろしくお願いします。