Excel（Microsoft Excel）で単語全体のみを置き換える

Sub ReplaceOnlySpecifirdWord()

Dim c As Range, rng As Range, rngArea As Range     Dim vFind As String, vReplace As String     Dim v As Variant     Dim arrSplit As Variant     Dim s As String     Dim i As Integer, n As Long     Dim b As Boolean     Const csDELIMITER = " "



On Error Resume Next     ' Reference Constants only     Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)

If rng Is Nothing Then         MsgBox "There are no constants on active sheet...", vbExclamation         Exit Sub     End If     On Error GoTo 0

' Get Find and Replace strings     v = InputBox(Prompt:="Please enter String to be replaced.")

If v <> "" Then         vFind = v     Else         MsgBox "Wrong entry; app is going to be terminated.", vbExclamation         Exit Sub     End If

v = InputBox(Prompt:="Please enter Replace String.")

If v <> "" Then         vReplace = v     Else         MsgBox "Wrong entry; app is going to be terminated.", vbExclamation         Exit Sub     End If

Application.ScreenUpdating = False     Application.Calculation = xlCalculationManual     n = 0     For Each rngArea In rng.Areas         For Each c In rngArea.Cells             b = False             arrSplit = Split(c.Value, csDELIMITER)

For i = LBound(arrSplit) To UBound(arrSplit)

If arrSplit(i) = vFind Then                     arrSplit(i) = vReplace                     n = n + 1                     b = True                 End If             Next i             If b Then                 s = vbNullString                 For i = LBound(arrSplit) To UBound(arrSplit)

s = s & arrSplit(i)

If i <> UBound(arrSplit) Then                         s = s & csDELIMITER                     End If                 Next i                 c.Value = s             End If         Next c     Next rngArea

Application.Calculation = xlCalculationAutomatic     MsgBox "Replaced " & n & " words...", vbInformation End Sub