Казанский, есть предположение (завтра проверю), что с использованием в предварительном цикле функции InStr для стрингового варианта и InStrB для массива байтов будет быстрее даже на очень длинных строках. Цифр всего десять (отдельно взятых в числовом букваре), т.е. начало подстроки (если она есть) с цифрами найдем очень быстро, а далее циклом добить до первого вхождения любого другого символа.
А касательно RegExp видимо основное время затрачивается на запуск процедуры внутри объекта, а сам поиск и извлечение занимает мало времени.
Но это все о извлечении целых положительных чисел) С отрицательными почти также с доп.проверкой на символ перед первой цифрой. А вот всяческие десятичные дроби наверное будут сложнее. Не говоря о математических выражениях.
----------
Предположения не оправдались:
Код |
---|
NumExtrA String Len: 10027 100000 123,312
NumExtrB String Len: 10027 100000 59,523
NumExtrAplus String Len: 10027 100000 10,027
NumExtr String Len: 10027 100000 1,805
|
1. перебирает все символы, склеивая цифры
2. тоже самое через байтовый массив
3. первичный поиск через InStr, потом склейка
4. RegExp
RegExp победил)
П.С.: Правда тест был не совсем корректен, т.к. массив 100000*10027(символов)=Out of string space, поэтому на каждом проходе из другой переменной восстанавливалось значение основной.
Врядли кому пригодится, но все-же :
Скрытый текст |
---|
Код |
---|
Function NumExtrAplus(txt$) As Boolean
Dim sb$, dt$, a&, ff As Boolean, b&, aa, c&
If Len(txt) = 0 Then Exit Function
aa = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "0"): b = Len(txt)
For a = 0 To 9
c = InStr(txt, aa(a))
If c > 0 Then
If c <= b Then ff = True: b = c
End If
Next
If Not ff Then Exit Function
For a = b To Len(txt)
sb = Mid$(txt, a, 1)
If sb Like "#" Then dt = dt & sb Else Exit For
Next
If Len(dt) > 0 Then txt = dt: NumExtrAplus = True
End Function |
|
Тестер:
Скрытый текст |
---|
Код |
---|
Sub test()
Dim dt$, a&, iTime#, RG As Object, txt$, b&
TextGen txt, 10000, 10000
txt = txt & "asd-1234556GHJYYTRR-1567575"
b = 100000: dt = txt
'-------------
iTime = Timer
For a = 1 To b: txt = dt: NumExtrA txt: Next
iTime = Timer - iTime
Debug.Print "NumExtrA"; Tab; "String Len: " & Len(dt); Tab; b; Tab; Round(iTime, 3)
iTime = Timer
For a = 1 To b: txt = dt: NumExtrB txt: Next
iTime = Timer - iTime
Debug.Print "NumExtrB"; Tab; "String Len: " & Len(dt); Tab; b; Tab; Round(iTime, 3)
iTime = Timer
For a = 1 To b: txt = dt: NumExtrAplus txt: Next
iTime = Timer - iTime
Debug.Print "NumExtrAplus"; Tab; "String Len: " & Len(dt); Tab; b; Tab; Round(iTime, 3)
iTime = Timer
Set RG = CreateObject("VBScript.RegExp")
RG.Pattern = "\d+"
For a = 1 To b
txt = dt: NumExtr txt, RG
Next
iTime = Timer - iTime
Debug.Print "NumExtr"; Tab; "String Len: " & Len(dt); Tab; b; Tab; Round(iTime, 3)
End Sub
Function TextGen(tt$, ByVal ss&, ByVal ll&)
Dim aa As Byte, x&, t$, arr() As Byte, a As Byte, c&, bb() As Byte
ReDim arr(1 To 4, 1 To 2)
arr(1, 1) = 65: arr(1, 2) = 25: arr(2, 1) = 97: arr(2, 2) = 25
arr(3, 1) = 192: arr(3, 2) = 31: arr(4, 1) = 224: arr(4, 2) = 31
t = ""
If ll - ss > 0 Then c = ss + (Rnd * (ll - ss)) Else c = ll
ReDim bb(1 To c)
For x = 1 To c
a = Rnd * 4
If a = 0 Then a = 1
aa = arr(a, 1) + (Rnd * arr(a, 2))
bb(x) = aa
Next
tt = StrConv(bb, 64)
End Function |
|