Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1 2 3 След.
RSS
Поиск значений в массиве для длинных строк (ВПР). Подсчёт количества повторений
 
Доброго времени суток, Планетяне!
Сразу оговорюсь, что такое обобщающее название из-за того, что все задачи я хочу решить похожими способами.

До недавнего времени в качестве ВПР использовал UDF на основе Match - работала довольно шустро и вполне себе устраивала. А на неделе столкнулся с проблемой, что Match не работает со строками длиннее 255 символов. А у меня, вследствие "сырости" и несовершенства связей бывают длинные "ключи". Ну а так как массивы быстрые, а в словаре удобно хранить, проверять и извлекать, то решил сочинить новую UDF на основе данных объектов.

Изучая словари (все ссылки ниже), понял, что словарь может показать "уникальность" объекта при добавлении в него или посчитать количество повторов, поэтому, по сути, хочу написать 2 UDF: чисто для ВПР и для определения количества вхождений.
Текущий ВПР на Match

UPD from 2018-02-16. Решения по ВПР: 1 и 2. До решения от Anchoret пока не дорос((

ССЫЛКИ:
Разбор вариантов ВПР
Словари
Пример только на массивах
Пример от Hugo на массивах и словаре
Сортировка двумерного массива от EducatedFool — использую, работает.
Продвинутый набор алгоритмов для супербыстрой сортировки из Копилки — не разобрался пока что
Изменено: Jack Famous - 16 Фев 2018 18:09:40
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Сортировка на словарях - плохая затея :) Проверено. Слабое место словарей - долгая загрузка в него данных.
Строковые ключи можно искать и в массивах методом первичного распределения (распихать по матрице). Только распихивать не значения, а индексы. Разбить по первой букве строки. Если значений мало, то прямой поиск. Если значений много, то делаем выборку индексов по второй букве искомой строки. И т.д..
Для разбивки строки на коды символов можно воспользоваться след.конструкцией:
Код
Dim bb() as byte' массив для кодов символов
Dim st as String
bb=StrConv(st,128)'или VBA константа vbFromUnicode 
 
подозреваю, что тема будет закрыта.
в заголовке нет описания задачи, которую нужно решить
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
заголовке нет описания задачи, которую нужно решить
Подозреваю, что автор темы хочет что-то предложить, а не спрашивать :)
 
По поводу UDF (ВПР) уточните, пожалуйста, максимальные размеры массива, т.к. от этого зависит решение. И как Вы используете эту UDF: в формулах (массивных?) ячеек или только в VBA? Сколько примерно ожидается обращений к одному и тому же массиву? Сколько таких массивов предполагается использовать в одной книге? Проще всего приложить пример.

И пока тему не закрыли, небольшой оффтоп по сортировкам:
Обычно приходится искать компромисс между скоростью,  функциональностью и удобством (простотой) применения. При увлечении одним из этих компонентов страдают остальные. При акценте на скорости кода сам код может выглядеть жутковато (использование GoTo label и т.п.) и/или заточен на узкое применение. При погоне за многофункциональностью (сортировка по возрастанию/убыванию, учёт регистра текста и многое другое) страдает скорость, а чрезмерное количество параметров, процедур и функций начинает отпугивать самых массовых пользователей. Что касается простоты, то чаще востребована сортировка по возрастанию без учета регистра текста. Абстрагирование от Excel (сортировка в VBA сама по себе) тоже редко кому нужна, встроенная сортировка вполне устраивает в большинстве типовых задач, но бывают случаи, когда хочется обойтись только VBA.
Еще бы хороший стиль написания (внятные имена переменных хотя бы), подробное комментирование, чтобы не изучать алгоритм по порой чудаковатому коду, и  внятное описание, желательно с примерами. Если понимать, для кого предлагается решение, то легче выбрать и правильный компромисс. Примеры точного попадания в целевую группу - Приемы Автора сайта.
Акцент на каких-то сложных т.н. вау-эффектах может оказаться воспринят только такими же «чудиками», как и автор креатива, хотя это вполне себе целевая группа, конечно :)

Добавлю ссылку. По сортировкам с подачи Слэна когда-то в теме «Как в VBA отсортировать массив?» обсуждался нерекурсивный алгоритм сортировки QuickSort, как наиболее быстрый для больших массивов. При этом был немного отшлифован код GSerg (Сергея Гергерта, насколько я понимаю) для одномерного массива, взятый  с vbnet.ru
В той же теме обсуждалось, что для 2D-массивов лучше (быстрее) вместо перестановок значений делать перестановки их индексов (номеров строк, а точнее - 2-й размерности) в массиве, а в конце – по этим индексам сформировать отсортированный массив. В том или ином виде код и методы используются и модифицируются во многих решениях на этом и других форумах.

Кстати, описания алгоритмов тоже бывают креативными, при этом еще понятными и даже завораживающими - Quick-sort with Hungarian folk dance
Изменено: ZVI - 10 Фев 2018 02:37:04
Vladimir Zakharov
Microsoft MVP – Office Apps & Services
 
Еще немного о сортировках :) Т.к. до сих пор интересуюсь этой темой, то переворошил инет в поисках информации. Краткая выжимка из прочитанного и опробованного:
Скрытый текст

Есть еще метод двоичного дерева, но насколько я понял этот метод только для чисел, т.е. не универсал по входным данным.
Также есть ABCsort от предприимчивого богослова (лицензированный и сертифицированный в США, но так и не попавший в Википедию).

Из лидеров по времени квиксорт, тимсорт и слияние наплевательски относятся к взаимоположению равных элементов, что важно для сортировки двумерного массива.  
Изменено: Anchoret - 14 Фев 2018 10:15:17
 
Из «медленных простых универсальных» ещё можно обратить внимание на т.н. гномью сортировку, главный бонус которой в сравнении с пузырьками — отсутствие вложенного цикла. Сложность та же n^2, но при прочих равных гномы обычно обгоняют пузырьки именно за счёт более оптимального распределения ресурсов.
 
Господа! Желаю всем здравствовать! Итак - по порядку…
Цитата
Anchoret написал:
Сортировка на словарях - плохая затея
я не собирался сортировать словари. Просто предполагаю, что, загрузив диапазон с листа в двумерный массив, перед тем как искать по нему, было бы неплохо отсортировать. Причём, вот тут увидел метод, когда массив загружается 1 раз для всего диапазона работы UDF и это, тип экономит кучу ресурсов (я понял как-то так). Предложенный вами метод преобразования строки в набор символов - это для бинарного поиска? А как его реализовать?)))
Цитата
Ігор Гончаренко написал:
в заголовке нет описания задачи, которую нужно решить
она там была - в подзаголовке темы "Суперфункции для ВПР и поиска количества вхождений дубликатов" (что-то типа того). Модераторы подчистили, наверное. Не удалили тему - и слава богу)))

ZVI, по размерам массивов, компромиссам и т.д.: для меня в приоритете надёжность, универсальность и удобство ввода. На данный момент я использую подход, когда в надстройке хранятся так называемые "базовые" модули с макросами и UDF. А уже в UDF листа или макросах для юзеров я использую обращение к этим "базовым" кодам. Например, есть куча функций проверки корректности:
Пример «базового модуля с функциями проверок»
Anchoret и Irregular Expression, о сортировках: в рамках моей задачи может и не нужно будет применять сортировки. Гляньте первые примеры кодов, пожалуйста

Вообще, ребят, многие очень крутые вещи, которые вы мне тут предлагаете для меня является тёмным лесом, т.к. по сути, я ещё нуб в VBA и, порой порю редкую чушь из-за того, что просто не знаю основ и "матчасти". Прошу простить и по-возможности просветить и помочь))
Обновил шапку
Изменено: Jack Famous - 13 Фев 2018 17:29:49
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Попробовал вот такие коды, но они жутко тупят
Изменённый вариант работает корректно
работает хоть и корректно, но в несколько раз дольше, чем Match (вероятно, из-за длинных ключей)
Тупой перебор ячеек
Перебор "в лоб" работает примерно также по скорости, как и предущий (Подтянуть3). Оба они решают проблему с длинными ключами, но хочется чего-то более быстрого и продвинутого))) пробую дальше)))

файл-пример добавляю в шапку и тут
Изменено: Jack Famous - 13 Фев 2018 22:17:07
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
В общем, по ВПР пока варианта 2:
1. делать проверку на длину строки и, в зависимости от этого использовать либо Match, либо "тупой перебор ячеек"
2. использовать метод от Anchoret, но я не знаю как :(
разобрался как работает функция, получил из строки массив типа Byte с кодами символов, но как их дальше сравнивать не понимаю…

Помогите, кто может, пожалуйста или подскажите другой вариант.
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
Jack Famous написал:
Предложенный вами метод преобразования строки в набор символов - это для бинарного поиска? А как его реализовать?)))
Не совсем. Для бинарного поиска нужен отсортированный массив. Вот примерный набросок, но результат по времени далек от идеала:
Скрытый текст

Для повышения скорости нужно идти по пути реализованном в текстовом сортере ранее) Т.е. две матрицы 255х255 и большие затраты п памяти.
Этот код ищет 10к элементов в массиве 500к примерно за 6 сек. Можно ускорить.
По поисковику:
Скрытый текст
Изменено: Anchoret - 13 Фев 2018 20:34:44
 
Цитата
Jack Famous написал:
разобрался как работает функция, получил из строки массив типа Byte с кодами символов, но как их дальше сравнивать не понимаю…
Вот еще одна функция для поиска одного байтового массива в другом с примером ее применения :)
Код
Sub qwe()
Dim aa() As Byte, zz() As Byte
e$ = "asdfghj"
aa = StrConv(e, 128)
zz = StrConv(Left$(e, 2), 128)
x = Asc(e)
If InStrB(1, aa, zz, 0) > 0 Then b = 1
End Sub
Изменено: Anchoret - 13 Фев 2018 20:45:19
 
Измененный вариант. Памяти жрет больше, но и работает в сотню раз быстрее:
Скрытый текст
Адаптируйте под свои нужды :)
 
Anchoret, ох - спасибо вам большое, спец!  :)
Ща попробую что-то изобразить)))
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
Jack Famous написал:
спец!
Не больше , чем Вы. Т.е. такой же пользователь, но чуть больше имевший дело с массивами.
 
Цитата
Anchoret написал:
Не больше , чем Вы
да нет - я следил за темой сортировки))) разница огромная, ведь я только совсем немного пишу))
подскажите пожалуйста - у макроса во входящих данных такие переменные: txt(), mass(), n%, arr, fc& - какая из них, для чего?
В код лезть не буду - я там мало что понимаю))) матрицы всякие, 32 - 255 (это типа коды символов) и прочее  :D
Изменено: Jack Famous - 14 Фев 2018 10:40:13
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Jack Famous, гляньте в посте #11
А в код лезть придется, если хотите научиться) Да, и там в коде нет проверки на пустые строки ни в поисковом списке, ни в проверяемом столбце массива.
Изменено: Anchoret - 14 Фев 2018 16:24:46
 
Цитата
Anchoret написал:
нет проверки на пустые строки
это не страшно)) мне проще проверить оба диапазона перед запуском вашего макроса двумя строчками своей функции))
по остальному: буду изучать)
Спасибо вам!
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Вообще смысл этой процедуры - сравнить два списка, и если во втором есть значения первого, то вывести индексы строк с совпадениями. А дальше уже человеку использующему процедуру решать как с этими данными поступать. Для единичного ВПР список из одного значения.
 
Anchoret, я прямо постараюсь разобраться) хоть и страшно))) буду писать сюда по мере продвижения  :)
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Не, искать этой процедурой по одному - слишком долго. Даже заточенным под одиночный поиск вариантом:
Код
Function sTxtFinder(txt$, mass(), ByVal n%, SResult&()) As Boolean
Dim ll&, hh&, cc As Byte, cc1 As Byte, a&, x&, dt1$
ReDim SResult(1 To 1) 'одномерный массив индексов
If txt = "" Then sTxtFinder = False: Exit Function
dt1 = UCase(txt): cc = Asc(dt1)
If Len(txt) > 1 Then cc1 = Asc(Mid(dt1, 2, 1))
ll = LBound(mass, 1): hh = UBound(mass, 1): x = 1
For a = ll To hh
  If Len(mass(a, n)) = Len(dt1) Then
    If Asc(UCase(mass(a, n))) = cc Then
      If Len(mass(a, n)) = 1 Then GoTo lp1
      If Asc(UCase(Mid(mass(a, n), 2, 1))) = cc1 Then
lp1:    If dt1 = UCase(mass(a, n)) Then
          ReDim Preserve SResult(1 To x)
          SResult(x) = a: x = x + 1
        End If
      End If
    End If
  End If
Next
If SResult(1) = 0 Then sTxtFinder = False Else sTxtFinder = True
End Function
Единственное, что приходит в голову - ВПРить по кнопке и сразу по нескольким столбцам, с массовой выгрузкой данных в поисковые массивы.
 
я так понимаю, что эта функция просто определяет, есть ли данное значение в массиве?… Она ж булевая.
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
а что говорят параметры функции?
 
у меня глючит окно комментариев)) печатать очень неудобно) параметры говорят, что нужно передать следующее:
txt$ — строку, которую ищем
mass() — динамический неопределённый массив, где искать строку
ByVal n% — непонятная до сих пор вещь))) as Integer, переданная значением, а не ссылкой
SResult&() — динамический неопределённый массив результатов As Long

как-то так я вижу))
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
вот мой вариант ВПР на массивах - ощущаемая скорость ниже гибрида Match с "тупым" перебором
Код
Public Function MassVPR(ByVal txt As String, ByRef rngSearch As Range, ByRef rngResult As Range)
Dim arrSrch, arrRes
Dim i&

arrSrch = rngSearch.Value2: arrRes = rngResult.Value2
    For i = 1 To UBound(arrSrch, 1)
        If arrSrch(i, 1) = txt Then MassVPR = arrRes(i, 1): Exit Function
    Next i
End Function
думаю, если заменить "тупой" перебор на эти массивы, оставив Match, то скорость будет выше. Реализация максимально простая. «Надёжная, блин, как швейцарские часы» и понятная мне)))
Продолжаю разбираться с бинарным поиском и ищу альтернативы))
Изменено: Jack Famous - 15 Фев 2018 11:15:30
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
есть идея каким-то образом использовать вот такие функции
Код
Public Function PRDX_CheckByListAll(WF_Check As Range, WF_List As Range) As String
Dim WF_cl As Range
Dim WF_delim$, WF_strList$, WF_strCheck$, WF_rez$
Dim i&

On Error GoTo er
    
WF_delim = "•••"
WF_strList = xlVBA_Range2TXT(WF_List, WF_delim, WF_delim, WF_delim)
WF_strList = WF_delim & xlVBA_ReplaceOfficeSymbols(WF_strList) & WF_delim

    For Each WF_cl In WF_Check
    WF_strCheck = "*" & WF_delim & xlVBA_ReplaceOfficeSymbols(WF_cl) & WF_delim & "*"
        If Not (WF_strList Like WF_strCheck) Then WF_rez = WF_rez & WF_delim & WF_cl.Value2
    Next WF_cl
    If WF_rez = "" Then PRDX_CheckByListAll = "ГОТОВО" Else: PRDX_CheckByListAll = Mid(WF_rez, Len(WF_delim) + 1)

GoTo fin
er:
PRDX_CheckByListAll = ""

fin:
End Function
'===================================================================================================================
Public Function PRDX_CheckByListOne(WF_cl As Range, WF_List As Range) As String
Dim WF_delim$, WF_strList$, WF_strCheck$

On Error GoTo er
    
WF_delim = "•••"
WF_strList = xlVBA_Range2TXT(WF_List, WF_delim, WF_delim, WF_delim)
WF_strList = WF_delim & xlVBA_ReplaceOfficeSymbols(WF_strList) & WF_delim
WF_strCheck = "*" & WF_delim & xlVBA_ReplaceOfficeSymbols(WF_cl) & WF_delim & "*"

    If WF_strList Like WF_strCheck Then PRDX_CheckByListOne = "НАЙДЕНО": GoTo fin

er:
PRDX_CheckByListOne = ""

fin:
End Function
'===================================================================================================================
Public Function xlVBA_Range2TXT(ByRef ra As Range, Optional ByVal ColumnsSeparator$ = "•", Optional ByVal RowsSeparator$ = "•", Optional ByVal AreasSeparator$ = "•") As String
Dim ar As Range
Dim arr
Dim i&, j&
Dim txt$

    If ra.Cells.Count = 1 Then xlVBA_Range2TXT = ra.Value2: Exit Function
    If ra.Areas.Count > 1 Then
        For Each ar In ra.Areas
            xlVBA_Range2TXT = xlVBA_Range2TXT & AreasSeparator$ & xlVBA_Range2TXT(ar, ColumnsSeparator$, RowsSeparator$)
        Next ar
        xlVBA_Range2TXT = Mid(xlVBA_Range2TXT, Len(AreasSeparator) + 1)
        Exit Function
    End If
    arr = ra.Value
    For i = LBound(arr, 1) To UBound(arr, 1)
        txt = "": For j = LBound(arr, 2) To UBound(arr, 2): txt = txt & ColumnsSeparator$ & arr(i, j): Next j
        xlVBA_Range2TXT = xlVBA_Range2TXT & Mid(txt, Len(ColumnsSeparator$) + 1) & RowsSeparator$
    Next i
xlVBA_Range2TXT = Left(xlVBA_Range2TXT, Len(xlVBA_Range2TXT) - 1)
End Function
'===================================================================================================================
Function xlVBA_ReplaceOfficeSymbols(ByVal WF_txt As String, Optional FileSymbols As Boolean = False) As String
Dim WF_arr
Dim WF_str$
Dim WF_i%

    If FileSymbols = True Then
        WF_str = "~!@/\#$%^&*=|`"""
            For WF_i = 1 To Len(WF_str)
                WF_txt = Replace(WF_txt, Mid(WF_str, WF_i, 1), "")
            Next WF_i
    Else
        WF_str = "~!?#*()[]{}`"""
        WF_arr = Array("tld", "vskl", "vprs", "rshtk", "zvzd", "skbkrl", "skbkrp", "skbkvl", "skbkvp", "skbfgl", "skbfgp", "pstrf2", "kvchk")
            For WF_i = 1 To Len(WF_str)
                WF_txt = Replace(WF_txt, Mid(WF_str, WF_i, 1), WF_arr(WF_i - 1))
                WF_txt = Replace(WF_txt, Chr(39), "pstrf1") 'замена апострофа
            Next WF_i
    End If

xlVBA_ReplaceOfficeSymbols = WF_txt
End Function
они супермегабыстрые и позволяют либо проверить конкретное значение на соответствие списку, либо сразу весь диапазон проверить и вывести в текстовую строку с разделителями все несоответствия
основано на методе, отсюда. Проблема в том, что проверяется только наличие или отсутствие и для своих задач вполне подходит. Однако до индекса никак не добраться(((
прошу прощения, что "простыня" кодов не под спойлером - не могу "нащупать" кнопку. Панель не отображается
Изменено: Jack Famous - 15 Фев 2018 11:07:41
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Модераторам: прошу сменить название темы на «Поиск значений в массиве для длинных строк (ВПР). Подсчёт количества повторений»

Всё-таки сортировка массивов, бинарный поиск и прочее - лишь методы для достижения цели. Так людям проще будет найти ответ.
Изменено: Jack Famous - 15 Фев 2018 11:33:49
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Но первые ответы даны были по сортировке... Вот что значит пытаться объять необъятное.
 
я прошу прощения за сумбур)) просто сортировка была первым моим предполагаемым решением проблемы. При этом в шапке я подчеркнул, какие задачи хочу решить.
Дело ещё в том, что сейчас для подсчёта количества дублей я "тупо" макросом сортирую "умную" таблицу и циклом считаю повторы. Вот и предположил, что сортировка массива, полученного из диапазона будет намного лучше. Но это, повторюсь, лишь один из способов решения проблемы.

Спасибо вам)
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
вот. только к #27 я понял о чем речь. (допустим, это личная проблема)
но общая проблема в том, что
в названии темы нужно описывать задачу, которую Вы решаете, а не метод(ы), который(е) Вы используете для ее решения
и, можно понять, когда на эти грабли наступают начинающие, но в данном случае, Jack Famous, я, мягко говоря, был удивлен
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Страницы: 1 2 3 След.
Читают тему (гостей: 1)
Наверх