Добрый день. Подскажите как из ячейки B1 извлечь номера в скобках, если их не один в одной ячейки. В идеале номера должны быть в столбце А по одному в ячейке.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Option Base 1
Option Explicit
'Option Private Module
'====================================================================================================
Function GetCode(ByVal v, Optional n& = 1, Optional Mask$ = "*") As String
Dim r&, rr&
If Not PRDX_TextBetweenSeps(v, "(", ")", False) Then Exit Function
If n > UBound(v) Then Exit Function
For r = 1 To UBound(v)
If v(r) Like Mask Then rr = rr + 1: v(rr) = v(r)
Next r
If n <= rr Then GetCode = v(n)
End Function
'====================================================================================================
Private Function PRDX_TextBetweenSeps(tmp, delL$, delR$, MsgFalse As Boolean) As Boolean
Dim arrOut(), i&
Dim lPos&, rPos&, lLen&, rLen&
lLen = Len(delL): rLen = Len(delR): If lLen = 0 Or rLen = 0 Then Stop: End
rPos = -rLen + 1: ReDim arrOut(Len(tmp) \ 2)
Do
lPos = InStr(rPos + rLen, tmp, delL)
If lPos = 0 Then Exit Do
rPos = InStr(lPos + lLen, tmp, delR)
If rPos = 0 Then Exit Do
i = i + 1: arrOut(i) = Mid$(tmp, lPos + lLen, rPos - lPos - lLen)
Loop
If i = 0 Then
If MsgFalse Then MsgBox "There are not separator «" & delL & "» and separator «" & delR & "» in String «" & tmp & "»!", vbCritical, "Text_Betweenseps"
Exit Function
End If
ReDim Preserve arrOut(i): tmp = arrOut: PRDX_TextBetweenSeps = True
End Function
'====================================================================================================
'====================================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: Пусть будет. Скрин, Файл и Код
Тогда ещё вариант. Вводится как массивная
Код
Function GetCode_2(ByVal v, Optional m& = 0, Optional s& = 0) 'As String
Dim r&
Set Dict = CreateObject("System.Collections.ArrayList")
If Not v Like "*(*)*" Then Exit Function
arr1 = Split(v, "(")
For n = LBound(arr1) + 1 To UBound(arr1)
r = InStr(arr1(n), ")")
If Not r <= 1 Then
If r - 1 = m Or m = 0 Then
If s = 0 Then
Dict.Add CStr(Split(arr1(n), ")")(0))
Else
If Not Dict.contains(CStr(Split(arr1(n), ")")(0))) Then Dict.Add CStr(Split(arr1(n), ")")(0))
End If
End If
End If
Next
GetCode_2 = WorksheetFunction.Transpose(Dict.ToArray)
End Function
Msi2102, строковые быстрее регулярок в этом случае, если что В моей темеАндрей VG как раз сравнивал скорости (и функция на строковых - его)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Я не про скорость, просто есть куча готовых и в принципе более универсальных вариантов, нужно было только поискать Добавил поиск по всему выделенному диапазону
Код
Function GetCode_2(ByVal v, Optional m& = 0, Optional s& = 0) 'As String
Dim r As Integer, n As Integer, rn As Range
Set Dict = CreateObject("System.Collections.ArrayList")
For Each rn In v
If rn Like "*(*)*" Then 'Exit Function
arr1 = Split(rn, "(")
For n = LBound(arr1) + 1 To UBound(arr1)
r = InStr(arr1(n), ")")
If Not r <= 1 Then
If r - 1 = m Or m = 0 Then
If s = 0 Then
Dict.Add CStr(Split(arr1(n), ")")(0))
Else
If Not Dict.contains(CStr(Split(arr1(n), ")")(0))) Then Dict.Add CStr(Split(arr1(n), ")")(0))
End If
End If
End If
Next
End If
Next
GetCode_2 = WorksheetFunction.Transpose(Dict.ToArray)
End Function
Msi2102: есть куча готовых и в принципе более универсальных вариантов
я не могу в качестве кода использовать то, принцип работы чего я не понимаю (и при это могу сделать понятный мне аналог). Надо сидеть и разбираться, что там имел ввиду автор и зачем.
Msi2102, вот вы, например, почему System.Collections.ArrayList вместо словарей и вообще зачем он тут ведь задача отбора уникальных не стояла?… Вот берёшь такое "готовое" решение, а потом думаешь, а почему оно работает не так, как ты хотел…
У меня же принцип простой: ищем первый разделитель, после него ищем второй. Если какой-то из низ не найден, то выходим. Если оба найдены, то берём всё, что между ними и повторяем. ТС не указал нюанс, что ему на самом деле не ВСЁ, что между скобок нужно, а только коды по понятной маске. Добавил в функцию возможность отфильтровать по маске.
Или как в соседней теме: готовое решение от ноунейма, который просто ошибся и вместо кириллической "р" (эр) латинскую "p" (пи) написал. А потом очень долго можно сидеть и думать, почему не сходится…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: Msi2102 , вот вы, например, почему System.Collections.ArrayList вместо словарей и вообще зачем он тут ведь задача отбора уникальных не стояла?…
Вначале я написал на Scripting.Dictionary (кстати он быстрее), но на работе была тошниловка и решил добавить немного плюшек . К тому же поиска по маске тоже не требовалось и тем не менее Вы её добавили.
Цитата
Jack Famous написал: Вот берёшь такое "готовое" решение, а потом думаешь, а почему оно работает не так, как ты хотел…
А что там может не так работать? Принцип тут такой же как и у Вас
Цитата
Jack Famous написал: У меня же принцип простой: ищем первый разделитель, после него ищем второй.
Msi2102: поиска по маске тоже не требовалось и тем не менее Вы её добавили
в примере ТС показал желаемый результат и это не ВСЕ значения из скобок, а только коды. У меня реализованы оба варианта - так универсальнее, в зависимости от потребности.
например, оно отбирает уникальные, а об этом ничего сказано не было. Тем более, что у вас это не опция (как у меня с маской), а единственный вариант работы функции.
как минимум, из-за отбора уникальных, это уже не так. К тому же, при вложенных скобках, наши варианты могут повести себя по-разному (не тестил, но так кажется)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: Тем более, что у вас это не опция
Почему, напишите так
Код
=GetCode_2(B1:B3)
и он выдаст все варианты
Цитата
Jack Famous написал: If Not r 0 — тоже "для разнообразия"?))
Нет, просто удаляю вариант если Внутри скобок пустота "()", если Ваш вариант, то при наличии () будут пустые ячейки
Цитата
Jack Famous написал: плюшка в виде заведомо более медленного
Оно конечно медленнее, но на сколько, сущие пустяки К тому же у Вас тоже есть ReDim Preserve ещё нужно посмотреть, что будет быстрее PS: В принципе скопировал на 1000 строк, результат моментальный, без задержек, общее количество найденных около 11000. Поэтому мне кажется, что у Вас просто предвзятое отношение к System.Collections.ArrayList