STDMETHODIMP CVBA::InStr(BSTR StringIn, BSTR StringFind, LONG Start, LONG* Position)
{
   LONG iSize = SysStringLen(StringIn);
   LONG fSize = SysStringLen(StringFind);
   *Position = 0;
   if (fSize == 0) return S_OK;
   if (Start < 1 || Start > iSize) return S_OK;
      
   for (LONG i = --Start; i < iSize; ++i)
   {
      if (StringIn[i] == StringFind[0])
      {
         for (LONG j = 1; j < fSize; ++j)
         {
            if (StringIn[i+j] != StringFind[j]) 
            {
               goto next;
            }
         }
         *Position = ++i;
         return S_OK;
      }
   next:;
   }
   return S_OK;
}

Option Explicit
Option Private Module
'====================================================================================================
Const rMax& = 100000
'----------------------------------------------------------------------------------------------------
Public Property Get arrFind()
arrFind = Array(" ", "\.", ",", ":", ";", "/", "a", "z")
End Property
'----------------------------------------------------------------------------------------------------
Public Property Get arrReplace()
arrReplace = Array(" ", ".", ",", ":", ";", "/", "a", "z")
End Property
'====================================================================================================
'====================================================================================================
'====================================================================================================
Sub Tester()
Dim arr(), txt$, i&, n&, t!
Dim strTest$: strTest$ = [a3].Value2

strTest = Replace(strTest, Chr(10), " ")
'strTest = WorksheetFunction.Trim(strTest)    'для теста Split
ReDim arr(rMax - 1)

    For i = 0 To UBound(arr)
        arr(i) = strTest
    Next i

t = Timer
    For i = 0 To UBound(arr)
'        InStrClassic arr(i)
'        InStrBedvit arr(i)
        ReplaceRegExp arr(i)
'        Replace4x arr(i)
'        ReplaceInStr arr(i)
    Next i
t = 1000 * (Timer - t)

[a1].Value2 = arr(0)
MsgBox Format$(t, "0 ms")
End Sub
'====================================================================================================
'====================================================================================================
'====================================================================================================
Sub InStrClassic(ival)
ival = InStr(1, ival, "FIND")
End Sub
'====================================================================================================
Sub InStrBedvit(ival)
Static bVBA As BedvitCOM.VBA: If bVBA Is Nothing Then Set bVBA = New BedvitCOM.VBA
ival = bVBA.InStr(ival, "FIND")
End Sub
'====================================================================================================
'====================================================================================================
Sub SplitReplace(ival)
Dim arr(), i&, ii&, n&

ReDim arr(Len(ival) - Len(Replace(ival, " ", "")))
i = InStr(1, ival, " ")

    Do While i
'        arr(n)=mid(ival,i+1,)
    Loop

ival = Join(arr, " • ")
End Sub
'====================================================================================================
'Sub SplitBedvit(ival)
'
'End Sub
'====================================================================================================
Sub Replace4x(ival)
Dim x, dx$, i&
Static bVBA As BedvitCOM.VBA:   If bVBA Is Nothing Then Set bVBA = New BedvitCOM.VBA

    For Each x In arrReplace
        dx = x & x
        For i = 1 To 4
'            ival = Replace(ival, dx, x)
            ival = bVBA.Replace(ival, dx, x)
        Next i
    Next x

End Sub
'====================================================================================================
'Sub t()
'Static bVBA As BedvitCOM.VBA:   If bVBA Is Nothing Then Set bVBA = New BedvitCOM.VBA
'MsgBox bVBA.Replace("анатолий", "а", "ы", , 2)
'End Sub
'====================================================================================================
Sub ReplaceInStr(ival)
Dim x, dx$, i&
Static bVBA As BedvitCOM.VBA:   If bVBA Is Nothing Then Set bVBA = New BedvitCOM.VBA

    For Each x In arrReplace
        dx = x & x
'        Do While InStr(1, ival, dx)
'            ival = Replace(ival, dx, x)
'        Loop

'        Do While bVBA.InStr(ival, dx)
        Do While InStr(ival, dx)
            ival = bVBA.Replace(ival, dx, x)
        Loop
    Next x

End Sub
'====================================================================================================
Sub ReplaceRegExp(ival)
Dim i&
Static RE As RegExp: If RE Is Nothing Then Set RE = New RegExp: RE.Global = True ': RE.MultiLine = True

    For i = 0 To UBound(arrFind)
        RE.Pattern = arrFind(i) & "{2,}"
        ival = RE.Replace(ival, arrReplace(i))
    Next i

End Sub

Option Explicit
Option Private Module
'====================================================================================================
Const rMax& = 1000000
'====================================================================================================
Public Property Get arrSym()
arrSym = Array(1, 2, 3, 4)
'arrSym = Array(1, 3)
'arrSym = Array(2, 4)
End Property
'====================================================================================================
'====================================================================================================
Sub Tester()
Dim arr(), txt$, i&, n&, t!
Dim strTest$: strTest$ = [a3].Value2

strTest = Replace(strTest, Chr(10), " ")
ReDim arr(rMax - 1)

    For i = 0 To UBound(arr)
        arr(i) = strTest
    Next i

t = Timer
    For i = 0 To UBound(arr)
        ReplaceCheck arr(i)
    Next i
t = 1000 * (Timer - t)

[a1].Value2 = arr(0)
MsgBox Format$(t, "0 ms")
End Sub
'====================================================================================================
'====================================================================================================
Sub ReplaceCheck(iVal)
Dim x
Static bVBA As BedvitCOM.VBA: If bVBA Is Nothing Then Set bVBA = New BedvitCOM.VBA

    For Each x In arrSym
'        If InStr(iVal, x) Then iVal = bVBA.Replace(iVal, x, "")
        iVal = bVBA.Replace(iVal, x, "")
    Next x

End Sub

Option Explicit
Option Private Module
'====================================================================================================
Const rMax& = 100000
'----------------------------------------------------------------------------------------------------
Public Property Get arrFind()
arrFind = Array(" ", "\.", ",", ":", ";", "/", "a", "z")
End Property
'----------------------------------------------------------------------------------------------------
Public Property Get arrReplace()
arrReplace = Array(" ", ".", ",", ":", ";", "/", "a", "z")
End Property
'----------------------------------------------------------------------------------------------------
Public Property Get arrSym()
arrSym = Array(1, 2, 3, 4)
'arrSym = Array(1, 3)
'arrSym = Array(2, 4)
End Property
'====================================================================================================
'====================================================================================================
'====================================================================================================
Sub Tester()
Dim arr(), txt$, i&, n&, t!
Dim strTest$: strTest$ = [a3].Value2

strTest = Replace(strTest, Chr(10), " ")
ReDim arr(rMax - 1)

    For i = 0 To UBound(arr)
        arr(i) = strTest
    Next i

t = Timer
    For i = 0 To UBound(arr)
        ReplaceCheck arr(i)
'        Replace4x arr(i)
'        ReplaceInStr arr(i)
'        ReplaceRegExp arr(i)
    Next i
t = 1000 * (Timer - t)

[a1].Value2 = arr(0)
MsgBox Format$(t, "0 ms")
End Sub
'====================================================================================================
'====================================================================================================
'====================================================================================================
Sub ReplaceCheck(iVal)
Dim x, i&
Static bVBA As BedvitCOM.VBA: If bVBA Is Nothing Then Set bVBA = New BedvitCOM.VBA

    For Each x In arrSym
        i = bVBA.InStr(iVal, x)
        If i Then iVal = bVBA.Replace(iVal, x, "", i)
'        iVal = bVBA.Replace(iVal, x, "")
'        If InStr(iVal, x) Then iVal = Replace(iVal, x, "")
'        iVal = Replace(iVal, x, "")
    Next x

End Sub
'====================================================================================================
Sub Replace4x(iVal)
Dim x, dx$, i&
Static bVBA As BedvitCOM.VBA: If bVBA Is Nothing Then Set bVBA = New BedvitCOM.VBA

    For Each x In arrReplace
        dx = x & x
        For i = 1 To 4
            iVal = Replace(iVal, dx, x)
'            iVal = bVBA.Replace(iVal, dx, x)
        Next i
    Next x

End Sub
'====================================================================================================
Sub ReplaceInStr(iVal)
Dim x, dx$, i&
Static bVBA As BedvitCOM.VBA:   If bVBA Is Nothing Then Set bVBA = New BedvitCOM.VBA

    For Each x In arrReplace
        dx = x & x

'i = InStr(iVal, dx)
'        Do While i
'            iVal = Left(iVal, i - 1) & Replace(iVal, dx, x, i)
'            i = InStr(iVal, dx)
'        Loop

        Do While InStr(iVal, dx)
            iVal = Replace(iVal, dx, x)
        Loop


'i = bVBA.InStr(iVal, dx)
'        Do While i
'            iVal = bVBA.Replace(iVal, dx, x, i)
'            i = bVBA.InStr(iVal, dx)
'        Loop
    Next x

End Sub
'====================================================================================================
Sub ReplaceRegExp(iVal)
Dim i&
Static RE As RegExp: If RE Is Nothing Then Set RE = New RegExp: RE.Global = True ': RE.MultiLine = True

    For i = 0 To UBound(arrFind)
        RE.Pattern = arrFind(i) & "{2,}"
        iVal = RE.Replace(iVal, arrReplace(i))
    Next i

End Sub
'====================================================================================================