|
置換処理を追加するなら、判定するための数式が複雑になりすぎるので、
maverickさんのようにループで一行ずつ見ていく形にした方がいいでしょう。
↓こんなコードで試してみて下さい。
Sub test_Rep()
Dim i As Long, Pta As Long, Ptb As Long
Dim Ptx As Long, Pty As Long, Ptz As Long
Dim GetP As Long
Dim txt As String, RepS As String
Application.ScreenUpdating = False
For i = Range("C65536").End(xlUp).Row To 1 Step -1
txt = Cells(i, 3).Value
Pta = InStr(1, txt, "東京都")
Ptb = InStr(1, txt, "殿")
If Pta > 0 And Ptb > 0 Then
RepS = Mid$(txt, Pta, Ptb - Pta + 1)
Ptx = InStr(1, RepS, "名前")
Pty = InStr(1, RepS, "氏名")
Ptz = InStr(1, RepS, "様方")
If Ptx > 0 Then
GetP = Ptx + 2
ElseIf Pty > 0 Then
GetP = Pty + 2
End If
If GetP > 0 Then
RepS = WorksheetFunction _
.Replace(RepS, GetP, Ptz - GetP, "●●●●")
GetP = 0
End If
Cells(i, 3).Value = RepS
Else
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
|
|