Страницы: 1
RSS
Альтернатива стандартной VBA функции Replace
 
В общем альтернатива быстрее, или я что-то намудрил...
Функция:
Код
Function aReplace(txt, findSStr$, replSStr$, Optional iComp& = 0) As String
Dim a&, b&, c&, arr$(), x&, f&, r&: f = Len(findSStr): r = Len(replSStr)
If f = 0 Then Exit Function
b = 0: a = InStr(1, txt, findSStr, iComp): c = 1
Do While a: b = b + 1: z = a + f: a = InStr(z, txt, findSStr, iComp): Loop: x = b
If b = 0 Then Exit Function
If z <= Len(txt) Then b = b + 1
aReplace = Space$(Len(txt) + (x * (r - f))): ReDim arr(1 To b)
b = 0: z = 1: a = InStr(1, txt, findSStr, iComp)
Do While a
  b = b + 1: arr(b) = Mid$(txt, z, a - z): z = a + f: a = InStr(z, txt, findSStr, iComp)
Loop
If Len(txt) >= z Then b = b + 1: arr(b) = Mid$(txt, z)
For a = 1 To UBound(arr)
  Mid$(aReplace, c, Len(arr(a))) = arr(b): c = c + Len(arr(a))
  If Len(aReplace) >= c Then Mid$(aReplace, c, r) = replSStr: c = c + r
Next
txt = b 'счётчик замен, только для теста функции
End Function

Тестер:
Скрытый текст
Время:
Скрытый текст
Изменено: Anchoret - 11.03.2019 04:50:37 (обновил тестовую процедуру)
 
Добрый день, многие увлекались соревнованием с Replace с помощью Mid$() :)
Но, например, этот тест  не пройдет:
Код
Sub Test()
  Debug.Print aReplace("123123", "12", "x"), Replace("123123", "12", "x")
  Debug.Print aReplace("123123", "1", "xx"), Replace("123123", "1", "xx")
End Sub

И и у штатной функции Replace есть еще параметры: Start и Count
 
ZVI, Доброго времени суток. Подправил функцию, точнее переписал заново. Теперь уже не такая шустрая)
 
Коллеги предлагаю самое быстрое решение для VBA(библиотека/надстройка). Быстрее стандартных в разы.
Если есть интерес, можем протестировать на вашей строке.
Изменено: bedvit - 11.08.2019 15:38:02
«Бритва Оккама» или «Принцип Калашникова»?
Страницы: 1
Наверх