Всем здрасте. Интересует наиболее быстрый алгоритм вычисления числа вхождения элементов одного массива в другой. Конкретно в моем случае, массивы - это натуральные числа, для упрощения скажем от1 до 20 В примере у меня есть решение через встроенные функции, и через VBA. Есть ли более быстрые алгоритмы?
зы. Функция у меня для примера алгоритма, в действительности это будет макрос и работа не с ячейками, а с массивами. Надо провести несколько миллионов сравнений.
Этот же вопрос запостил здесь. Сегодня выходной - что просмотров мало.
Имхо, словарь будет медленнее, чем через массивы. Для не числовых значений без словаря или коллекции, скорее всего не обойтись. Но у меня конкретный вариант - натуральные числа.
Михаил, а повторениями что считать? Например, формула из файла вернет 5, если в ячейку В1 ввести 20. А Ваша пользовательская функция - вернет 4.
Я бы сделал так. См.вложение. Применил словарь. Большая часть времени как правило уходит на его создание. Поэтому если функция будет использована для многих ячеек это может значительно сократить скорость выполнения. Исходя их этого объявлен переменной модуля, что позволяет создавать словарь один раз, а в последствии лишь заменять его значения.
Забыл сказать, что в моем случае в пределах одного массива все значения уникальны. Поэтому и формула и ЮДФ вернут одинаковые значения. Но, в принципе, меня интересует вхождение уникальных, т.е 4. Формулу могу для этого переделать, наверное, но такая задача не стоит.
Option Explicit
Dim dicR2 As Object
Function CountTwinDic(rR As Range, rR2 As Range)
Dim avR1, avR2, lr As Long, lc As Long, sItem As String, lCnt As Long
If dicR2 Is Nothing Then
Set dicR2 = CreateObject("Scripting.Dictionary")
Else
dicR2.RemoveAll
End If
avR1 = rR.Value
If Not IsArray(avR1) Then ReDim avR1(1 To 1, 1 To 1): avR1(1, 1) = rR.Value
avR2 = rR2.Value
If Not IsArray(avR2) Then ReDim avR2(1 To 1, 1 To 1): avR2(1, 1) = rR2.Value
For lr = 1 To UBound(avR2, 1)
For lc = 1 To UBound(avR2, 2)
sItem = avR2(lr, lc)
If Len(sItem) > 0 Then
If dicR2.exists(sItem) = False Then
dicR2.Add sItem, 1
End If
End If
Next lc
Next lr
For lr = 1 To UBound(avR1, 1)
For lc = 1 To UBound(avR1, 2)
sItem = avR1(lr, lc)
If Len(sItem) > 0 Then
If dicR2.exists(sItem) Then
lCnt = lCnt + 1
End If
End If
Next lc
Next lr
CountTwinDic = lCnt
End Function
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Мне нужно посчитать, сколько совпадений каждая строка таблицы имеет с каждой строкой. Пример в файле. Таких строк - несколько тыс. 500 строк обрабатывается примерно за 3 сек. - есть ли более быстрый алгоритм?
Function i_ЧС&(r1 As Range, r2 As Range)
Dim iMin&, iMax&, arr&(), a1(), a2(), i&, j&, t&
iMin = Application.Min(r1): iMax = Application.Max(r1)
ReDim arr(iMin To iMax)
a1 = r1.Value: a2 = r2.Value
For i = 1 To UBound(a1)
For j = 1 To UBound(a1, 2)
arr(a1(i, j)) = 1
Next j, i
For i = 1 To UBound(a2)
For j = 1 To UBound(a2, 2)
If a2(i,j) >= iMin Then
If a2(i,j) <= iMax Then t = t + arr(a2(i, j))
End If
Next j, i
i_ЧС = t
End Function
упс... вариант Михаила не смотрел, открывал файл Михалыча (С.М.). кажется, у меня получилось "изобретение велосипеда с квадратными колёсами". да и задачу я, возможно, недопонял.
но практически уверен - на массивах с единичками-нуликами будет быстрее, нежели со словарями или строками-фильтрами.
фрилансер Excel, VBA - контакты в профиле "Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
эт почему? есть огромное количество задач, работающих с данными среднего и даже малого объема. как правило, скорость работы там не столь важна. а вот скорость создания кода и удобство внесения изменений в него играют более важную роль. чтобы через некоторое время открыть код, поменять один критерий-шаблон-запрос - и готово.
а все эти (i,j) и иже с ними - для счастливых обладателей сотен тысяч строчек в сотнях и тысячах файликов
Filter - хорошая функция. правда, иногда маломощная.
фрилансер Excel, VBA - контакты в профиле "Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг