Sub test01() Fr = Range("

質問

Sub test01()
Fr = Range("A1").End(xlDown).Row
LR = Range("A100000").End(xlUp).Row
For i = Fr + 1 To LR
If Cells(i, "A") Like " *" Then
Cells(i, "A").Replace What:="", Replacement:="", LookAt:=xlPart, MatchCase:=True
End If
Next i
End Sub

""の中には置換前後の値が入る 各行のセルの1番最初の文字の塊を置換するこのマクロは一度に一値しか置換できませんが一度に10ぐらいの多くの値を置換できるよう改造したマクロを教えてください

回答No.1

SI299792 · ベストアンサー

右端がスペースの時置換を行うというのでいいでしょうか。
https://okwave.jp/qa/q9836487.html
の時同様、C2～C11 に検索文字、D2～D11 に痴漢文字を置いて実行して下さい。

Option Explicit
'
Sub Macro1()
　　Dim Row As Long
　　Dim Expression As String
'
　　For Row = [A1].End(xlDown).Row To Cells(Rows.Count, "A").End(xlUp).Row
　　　　Expression = Cells(Row, "A")
'
　　　　If Expression Like " *" Then
　　　　　　Cells(Row, "A") = MaltiReplace(Expression, [C2:D11])
　　　　End If
　　Next Row
End Sub
'
Function MaltiReplace(Expression As String, FindArea As Range)
　　Dim Row As Integer
　　Dim FindStr As String
　　Dim ReplStr As String
'
　　MaltiReplace = Expression
'
　　For Row = 1 To FindArea.Rows.Count
　　　　FindStr = FindArea(Row, 1)
　　　　ReplStr = FindArea(Row, 2)
　　　　MaltiReplace = Replace(MaltiReplace, FindStr, ReplStr)
　　Next Row
End Function
Option Explicit
'
Sub Macro1()
　　Dim Row As Long
　　Dim Expression As String
'
　　For Row = [A1].End(xlDown).Row To Cells(Rows.Count, "A").End(xlUp).Row
　　　　Expression = Cells(Row, "A")
'
　　　　If Expression Like " *" Then
　　　　　　Cells(Row, "A") = MaltiReplace(Expression, [C2:D11])
　　　　End If
　　Next Row
End Sub
'
Function MaltiReplace(Expression As String, FindArea As Range)
　　Dim Row As Integer
　　Dim FindStr As String
　　Dim ReplStr As String
'
　　MaltiReplace = Expression
'
　　For Row = 1 To FindArea.Rows.Count
　　　　FindStr = FindArea(Row, 1)
　　　　ReplStr = FindArea(Row, 2)
　　　　MaltiReplace = Replace(MaltiReplace, FindStr, ReplStr)
　　Next Row
End Function

補足

置換するのは一番左の値です　間違えました　失礼しました