Function Kol_vo(cell As String) As Integer
Dim mo As Object
Dim n As Integer
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "i[^i]+i"
If .test(cell) Then
Set mo = .Execute(cell)
Kol_vo = Len(mo(0)) - 2
For n = 1 To mo.Count - 1
If Len(mo(n)) - 2 > Kol_vo Then
Kol_vo = Len(mo(n)) - 2
End If
Next
End If
End With
End Function
' найти максимальное расстояние между символами F в тексте T
Function MaxDistanceBethFinT&(F$, T$)
Dim re, ms, m
Set re = CreateObject("VBScript.RegExp"): re.Global = True
re.Pattern = F & "[^" & F & "]+" & F: re.MultiLine = True
If re.test(T) Then
Set ms = re.Execute(T)
For Each m In ms
If m.Length - 2 > MaxDistanceBethFinT Then _
MaxDistanceBethFinT = m.Length - 2
Next
End If
End Function
Function MaxDist(s As String, txt As String) As Long
Dim i As Long, j As Long, m As Long
i = InStr(txt, s)
While i > 0
j = InStr(i + 1, txt, s)
If j - i - 1 > m Then m = j - i - 1
i = j
Wend
MaxDist = m
End Function
Собственно все тоже что и всегда, но 1. Обрезка краюшек требуется :-( 2. X пришлось заменить на Икс, а то там Ха было массивная =IFERROR(MAX(FREQUENCY(IF(MID($B2;ROW(INDEX($A:$A;FIND(LOWER(RIGHT(C$1));$B2)):INDEX($A:$A;LEN($B2)-LEN(TRIM(RIGHT(SUBSTITUTE(LOWER($B2);LOWER(RIGHT(C$1));REPT(" ";99));99)))));1)<>LOWER(RIGHT(C$1));ROW(INDEX($A:$A;FIND(LOWER(RIGHT(C$1));$B2)):INDEX($A:$A;LEN($B2)-LEN(TRIM(RIGHT(SUBSTITUTE(LOWER($B2);LOWER(RIGHT(C$1));REPT(" ";99));99)))))); IF(MID($B2;ROW($1:$98);1)=LOWER(RIGHT(C$1));ROW($1:$98))));"")
Тохе хотел строковыми попробовать. Получилось по скорости также или незаметно быстрее, чем у MCH
2 функции и тестовый стенд
Код
Option Explicit
'====================================================================================================
Function MaxDist_PRDX(vl$, sym$) As Long
Dim iMax&, i&, j&, l&
i = InStr(vl, sym)
Do
j = InStr(i + 1, vl, sym)
If j = 0 Then Exit Do
l = j - i - 1: i = j
If l > iMax Then iMax = l
Loop
MaxDist_PRDX = iMax
End Function
'====================================================================================================
Sub t()
Dim tx$, sym$, n&, i&, t!
tx = "iixzizzixxziix"
sym = "i"
t = Timer
For n = 1 To 1000000
i = MaxDist_MCh(sym, tx)
Next n
Debug.Print Fix(1000 * (Timer - t)), i
End Sub
'====================================================================================================
Function MaxDist_MCh(s As String, txt As String) As Long
Dim i As Long, j As Long, m As Long
i = InStr(txt, s)
While i > 0
j = InStr(i + 1, txt, s)
If j - i - 1 > m Then m = j - i - 1
i = j
Wend
MaxDist_MCh = m
End Function
'====================================================================================================
Результаты прогона 1 млн раз строки "iixzizzixxziix": не более 0,5 сек для поиска максимального расстояния между каждым символом
P.S.:Рубикон, отредактируйте ваше сообщение - не надо писать через строку или с такими огромными отступами
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
потому что её нет Здравствуйте, Михаил! Я просто написал свой вариант, а потом увидел ваш и решил сравнить по скорости - разницы практически нет: 441-476 / 296-316 / 335-367 для символов ixz соответственно (время в мс на 1млн чуууууууть быстрее, но в пределах погрешности)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Да выкладывай, я уже, тем более что не понятно что сравниваем. если не извлекать символ искомый из заголовка то естесвенно короче .... то есть решение для предложенной таблицы которое можно протянуть сравниваем?
быстродействие сравнивать не будем, MMULT проиграет :-) Тезка, только так не лучше? =MAX(;MMULT(IFERROR(SEARCH(E$1;$B9;ROW($1:$98)+{0\1}););{-1;1})-1) =МАКС(;МУМНОЖ(ЕСЛИОШИБКА(ПОИСК(C$1;$B2;СТРОКА($1:$98)+{0;1}););{-1:1})-1)
Off. Об Избушке. Я когда-то писал одному из уважаемых модераторов, как сделать правила подсчета результатов "международными" (чтобы они не зависели от изобретателей и переводчиков имен функций Excel, как в этой теме) но мой глас остался без ответа. Если интересно, могу написать в Избушке.
Off Владимир, лично мое мнение, хороша не только короткая , но и эффективно быстрая формула. Спасибо тезке, толкнул на размыслить и поискать совершенно иной подход.
И как водится замер скорости на 136000 строк
Скрытый текст
=MaxDist(C$1,$B2) 2,234375 - ну тут понятно почему лидер нечего гонять 99 раз когда можно меньше в разы =MAX(MMULT(IFERROR(SEARCH(C$1,$B2,ROW($1:$98)+{0,1})+{1,0},),{-1;1})) 6,96875 =MAX(MMULT(IFERROR(SEARCH(C$1,$B2,ROW($1:$98)+{0,1}),),{-1;1})-1,) 6,523438 =MAX(,IFERROR(SEARCH(C$1,$B2,ROW($2:$99))-SEARCH(C$1,$B2,ROW($1:$98))-1,)) 5,304688 =IFERROR(MAX(FREQUENCY(IF(MID($B2,ROW(INDEX($A:$A,FIND(C$1,$B2)):INDEX($A:$A,LEN($B2)-LEN(TRIM(RIGHT(SUBSTITUTE($B2,C$1,REPT(" ",99)),99))))),1)<>C$1,ROW(INDEX($A:$A,FIND(C$1,$B2)):INDEX($A:$A,LEN($B2)-LEN(TRIM(RIGHT(SUBSTITUTE($B2,C$1,REPT(" ",99)),99)))))), IF(MID($B2,ROW($1:$98),1)=C$1,ROW($1:$98)))),"") 12,53125
но стоило ввести ограничение по количеству символов, которое обсчитывается и
Sub MaxDistanceBethFinT()
Const f$ = "i"
Dim re, ms, m, t, tm#, r&
tm = Timer: t = [a1].CurrentRegion
Set re = CreateObject("VBScript.RegExp"): re.Global = True
re.Pattern = f & "[^" & f & "]+" & f: re.MultiLine = True
For r = 1 To UBound(t)
If re.test(t(r, 1)) Then
Set ms = re.Execute(t(r, 1)): t(r, 1) = 0
For Each m In ms
If m.Length - 2 > t(r, 1) Then t(r, 1) = m.Length - 2
Next
End If
Next
[c1].Resize(UBound(t), 1) = t
MsgBox Timer - tm
End Sub
у меня на компьютере около 2.5 сек 136 тыс ячеек колонки А заполнены этим: iixzizzixxziix
или заточенная под эту задачу процедура
Код
[/CODE][SPOILER][CODE]Sub MaxDistanceBethFinT()
Const f$ = "i"
Dim m&, mm&, t, tm#, r&, p1&, p2&
tm = Timer: t = [a1].CurrentRegion
For r = 1 To UBound(t)
p1 = InStr(t(r, 1), f): mm = 0
Do
If p1 < Len(t(r, 1)) Then p2 = InStr(p1 + 1, t(r, 1), f)
m = p2 - p1 - 1: If m > mm Then mm = m
If p2 = 0 Then Exit Do Else p1 = p2
Loop
t(r, 1) = mm
Next
[c1].Resize(UBound(t), 1) = t
MsgBox Timer - tm
End Sub
БМВІгор Гончаренко спасибо Вам и Людям принявшим участие в обсуждении! Мой чайник как мог так и сварил, а "заключения" по поводу скорости обработки, что чай без заварки и сахара, и не надо обращать внимания. Попробую разобраться с быстродействием функций... Меня вполне устраивают рабочие формулы! Еще раз СПАСИБО!
Что-то я опять поздно проснулся. Если есть уверенность, что символ встречается больше одного раза, то можно воспользоваться формулой: =АГРЕГАТ(14;6;ПОИСК(ПРАВБ(C$1);$B2;СТРОКА($1:$99))-СТРОКА($1:$99);1) *Неправильная формула.