Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1 2 След.
RSS
Подсчет количества уникальных значений в массиве
 
Здравствуйте.  
 
Нужна небольшая Ваша помощь. Уже не первый день ломаю голову над этой задачкой. Нужно подсчитать количество уникальных значений в массиве и частоту их появления, т.е. значение "7" столько то раз, значение "12" столько то раз и т.д.  
 
Заранее благодарен.
 
Для этого нужна функция СЧЁТЕСЛИ()- масса примеров на форуме.  
Для подсчета уникальных: =СУММПРОИЗВ(1/СЧЁТЕСЛИ(A4:P16;A4:P16))
 
СЧЁТЕСЛИ
 
kim,  
=СУММПРОИЗВ(1/СЧЁТЕСЛИ(A4:P16;A4:P16))- это здОрово!  
Элементарно просто и элегантно.    
Не встречал такого раньше, поэтому написАл UDF:  
 
Function СЧЁТ_РАЗНЫХ(Диапазон As Range) As Long  
'---------------------------------------------------------------------------------------  
' Procedure    : СЧЁТ_РАЗНЫХ  
' Author       :    
' Topic_HEADER : Функция СЧЁТ_РАЗНЫХ (UDF)  
' Topic_URL    : http://www.planetaexcel.ru/forum.php?thread_id=15009&useraction=login  
' Post_Author  : Alex_ST & The_Prist & Лузер™  
' Post_URL     :  
' DateTime     : 06.04.10, 12:00  
' Purpose      : возвращает число уникальных значений в указанном диапазоне  
' Notes        :  
'---------------------------------------------------------------------------------------  
  Dim iCell As Range  
  Set Диапазон = Intersect(Диапазон.Parent.UsedRange, Диапазон)  
  On Error Resume Next  
  With New Collection  
     For Each iCell In Диапазон  
        If iCell.Value <> "" Then .Add iCell.Value, Trim(iCell.Value)  
     Next  
  СЧЁТ_РАЗНЫХ = .Count  
  End With  
End Function
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
К стати, kim, не посоветуете,  
а как в формуле =СУММПРОИЗВ(1/СЧЁТЕСЛИ(A4:P16;A4:P16)) обойти ошибку #ДЕЛ/0! если в диапазоне попадается хотя бы одна пустая ячейка?
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
=СУММПРОИЗВ(1/СЧЁТЕСЛИ(A4:P16;A4:P16&""))-1
 
Спасибо.  
А почему -1 в конце формулы вдруг появилось?  
Уникальных значений раньше было 48, а теперь вдруг получилось 47.    
Да и мой макрос говорит, что их всё-таки 48...
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
Алексей, поищите огрехи в макросе :)  
Дело в том, что в таком виде, формула интерпретирует пусто как еще одно уникальное, вот мы его и отнимаем. Для более простого визуального восприятия уменьшил проверяемый диапазон.
 
да, но если пустых ячеек все же нет?  :)
Живи и дай жить..
 
Макрос считает правильно. Проверялось не раз (в том числе даже и ручным пересчётом).  
А вот усовершенствованная вами формула даже в исходном примере топик-стартера (т.е. без пустых ячеек в диапазоне) даёт 47, когда реально и моим макросом и вашей же исходной формулой там 48 уникальных значений...
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
К стати, знатоки VBA, помогите, плиз...  
Что-то у меня не получается сделать на основе этой классной формулы UDF (ну, чтобы потом формулы писАть было проще и не указывать два раза диапазон)  
Даже без игнорирования пустых ячеек...  
Пытаюсь сделать так:  
Function СЧЁТ_РАЗНЫХ_2(Диапазон As Range) As Long  
  '=СУММПРОИЗВ(1/СЧЁТЕСЛИ(Диапазон;Диапазон))  
  With Application.WorksheetFunction  
     СЧЁТ_РАЗНЫХ_2 = .SumProduct(1 / .CountIf(Диапазон, Диапазон))  
  End With  
End Function  
 
выдаёт #ЗНАЧ!
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
массив  
=СУММ(1/(ЕСЛИ(СЧЁТЕСЛИ(A4:P16;A4:P16);СЧЁТЕСЛИ(A4:P16;A4:P16);1)))-СЧЁТЕСЛИ(A4:P16;"")  
Если пустые не считаем за уникальные
 
Михаил,  
так может быть и будет работать (честно говоря, даже не проверял), но в вашем примере теряется вся простота и элегантность предложенной kim формулы...  
Ну, разве можно сравнить по трудоёмкости написания и возможному при этом количеству ошибок формулы:  
=СУММПРОИЗВ(1/СЧЁТЕСЛИ(A4:P16;A4:P16))    
и формулу массива  
={СУММ(1/(ЕСЛИ(СЧЁТЕСЛИ(A4:P16;A4:P16);СЧЁТЕСЛИ(A4:P16;A4:P16);1)))-СЧЁТЕСЛИ(A4:P16;"")}
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
{quote}{login=Alex_ST}{date=17.06.2010 11:00}{thema=}{post}К стати, знатоки VBA, помогите, плиз...  
Что-то у меня не получается сделать на основе этой классной формулы UDF{/post}{/quote}Вкладывать worksheetfunction'ы так нельзя.  
 
Function СЧЁТ_РАЗНЫХ_2(Диапазон As Range) As Long  
'=СУММПРОИЗВ(1/СЧЁТЕСЛИ(Диапазон;Диапазон))  
СЧЁТ_РАЗНЫХ_2 = Evaluate("SumProduct(1/CountIf(" & Диапазон.Address & "," & Диапазон.Address & "))")  
End Function
 
а не надо этой "элегантности"  :)  
 
в vba эффективнее будет простым перебором, только к вашему алгоритму еще добавить считываение диапазона в массив..  
 
а в этой элегантной формуле перебор происходит не один раз, а по количеству элементов - для каждого из элементов массива происходит перебор всех "остальных элементов", сравнение с условием и увеличение индекса, если условие выполнено.  
 
я уж не говорю о последующем делении и опять суммировании..
Живи и дай жить..
 
{quote}{login=Alex_ST}{date=17.06.2010 11:08}{thema=}{post}Михаил,  
так может быть и будет работать (честно говоря, даже не проверял), но в вашем примере теряется вся простота и элегантность предложенной kim формулы...  
Ну, разве можно сравнить по трудоёмкости написания и возможному при этом количеству ошибок формулы:  
=СУММПРОИЗВ(1/СЧЁТЕСЛИ(A4:P16;A4:P16))    
и формулу массива  
={СУММ(1/(ЕСЛИ(СЧЁТЕСЛИ(A4:P16;A4:P16);СЧЁТЕСЛИ(A4:P16;A4:P16);1)))-СЧЁТЕСЛИ(A4:P16;"")}{/post}{/quote}  
ну может вы и правы;  
=СУММПРОИЗВ(1/СЧЁТЕСЛИ(A4:P16;A4:P16&""))-ИЛИ(A4:P16="")  
тоже массив
 
{quote}{login=слэн}{date=17.06.2010 11:20}{thema=}{post}... к вашему алгоритму еще добавить считывание диапазона в массив...{/post}{/quote}  
Не понял, зачем?  
Быстрее работать что ли будет если я сначала скопирую диапазон во временный массив, а потом буду брать по одному элементу массива и пытаться добавить его в коллекцию (метод проверки уникальности по Уокенбаху)?  
 
Я, к стати, искал где-нибудь данные о скорости выполнения операций с коллекциями, но не нашел... Что-то мне подсказывает, что она не слишком велика (ну, по крайней мере не выше, чем обращение к ячейке диапазона). Поэтому, наверное, выигрыш в скорости при использовании массива вместо прямого обращения к ячейкам будет незначительным...
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
гораздо быстрее
Живи и дай жить..
 
Алексей, а протестируй разные методы и отпишись?  
Для тестов создай массив из миллиона случайных чисел в диапазоне 1...200 000.
 
{quote}{login=Alex_ST}{date=17.06.2010 11:42}{thema=Re: }{post}{quote}  
Что-то мне подсказывает, что она не слишком велика (ну, по крайней мере не выше, чем обращение к ячейке диапазона). {/post}{/quote}  
 
 
 
да, коллекции медленнее чем массив, но скорость выявления уникальности ключей очень высока (подразумеваю, что ключи там хранятся упорядоченно) - в этом и выигрыш. Еще быстрее конструкция dictionarys.. и удобнее. Но требует подключения доп библиотеки.
 
По просьбам слушателей во время обеденного перерыва (раньше работа мешала) сделал сравнение разных методов подсчёта числа уникальных значений в диапазоне.  
Конечно, создавать "массив из миллиона случайных чисел в диапазоне 1...200 000" я не стал, т.к. времени жалко, но с меньшим размером попробовал.  
Так вот, при обработке массива из 10 000 цифр от 0 до 100 на моём не шустром рабочем компе получилось следующее:  
1. Мой макрос с прямым считыванием значений из диапазона и добавлением в коллекцию    
СЧЁТ_РАЗНЫХ_1 - 0,44 сек.  
2. Мой доработанный макрос с предварительным копированием из диапазона в массив и добавлением в коллекцию уже из этого массива    
СЧЁТ_РАЗНЫХ_2 - 0,094 сек.  
3. Макрос, реализующий на VBA функцию листа =СУММПРОИЗВ(1/СЧЁТЕСЛИ(Диапазон;Диапазон))    
СЧЁТ_РАЗНЫХ_3 - 38,22 сек.  
 
Да... Гуру форума, конечно, обычно правы, но чтобы разница во времени выполнения достигала более 400 раз...!!! Не ожидал.  
 
Так что, формулисты, бросайте своё тормозное занятие и пишите макросы и UDF!!!
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
Интересно! А функция листа как таковая?
 
{quote}{login=Alex_ST}{date=17.06.2010 02:27}{thema=}{post}  
Так что, формулисты, бросайте своё тормозное занятие и пишите макросы и UDF!!!{/post}{/quote}Ага, а потом выясняется что расчётный файл не работал у начальника на деловой презентации потому что макросы отключены были.  
И стоя на бирже труда макрописец упрямо повторяет себе: "А у меня считает-то всё-равно быстрее"...  
Брр.
 
и еще можно немножко причесать.. :)  
 
например, зачем в коллекцию передавать значение, если нужно только посчитать?  
 
передавайте только ключ
Живи и дай жить..
 
{quote}{login=Serge 007}{date=17.06.2010 02:35}{thema=Re: }{Ага, а потом выясняется что расчётный файл не работал у начальника на деловой презентации потому что макросы отключены были.  
И стоя на бирже труда макрописец упрямо повторяет себе: "А у меня считает-то всё-равно быстрее"...  
Брр.{/post}{/quote}  
 
или пересчет был отключен :)
Живи и дай жить..
 
{quote}{login=слэн}{date=17.06.2010 02:39}{thema=}{post}  
или пересчет был отключен :){/post}{/quote}Не согласен. Для того что бы пересчёт отключить надо лесть в настройки, а это мало кто делает (я вообще ещё не встречал таких сотрудников кто знает как это делается). А вот уровень безопасности АЙтишники всегда ставят высокий и тут уже необходимы знания что бы их (макросы) включить.  
Так что это не одно и тоже...
 
У меня есть такие цифры при копировании 3000 уникальных из 11000  макросами:  
 
Degassad 4.171125  
For Each 1.625004  
For i 2.422002  
Dictionary 1.530991  
AdvFilter 0.280985355  
 
Сами коды:  
 
Sub btnDeggasad_Click()  
Dim aOld, aNew, i As Long, str As String  
Start! = Timer  
aOld = [a1:a12000]
str = ""  
For i = 1 To UBound(aOld)  
 If InStr(1, str, aOld(i, 1)) = 0 Then str = str & aOld(i, 1) & "|"  
Next i  
aNew = Split(str, "|") ' последнее значение пустое  
 
For i = 0 To UBound(aNew) - 1  
   Cells(i + 1, 2) = aNew(i)  
Next  
 Cells(2, 5) = Timer - Start  
 Cells(2, 6) = UBound(aNew) + 1  
 
[CalcTime] = Timer - Start
End Sub  
 
Sub btnCollections1_Click()  
Dim NewMyArray(), MyArray  
Dim Col As New Collection  
Start! = Timer  
On Error Resume Next  
MyArray = [a1:a12000]
For Each a In MyArray  
 Col.Add a, CStr(a)  
Next a  
'Если работа с коллекцией далее неприемлема, то перебросить её в массив  
'ReDim NewMyArray(1 To Col.Count)  
i = 1  
For Each a In Col  
'  NewMyArray(i) = a  
 Cells(i, 2) = a  
 i = i + 1  
Next  
 Cells(3, 5) = Timer - Start  
 Cells(3, 6) = Col.Count  
[CalcTime] = Timer - Start
End Sub  
 
Sub btnCollections2_Click()  
Dim NewMyArray(), MyArray  
Dim Col As New Collection  
Start! = Timer  
On Error Resume Next  
MyArray = [a1:a12000]
For Each a In MyArray  
 Col.Add a, CStr(a)  
Next a  
'Если работа с коллекцией далее неприемлема, то перебросить её в массив  
ReDim NewMyArray(1 To Col.Count)  
For i = 1 To Col.Count  
'  NewMyArray(i) = Col(i)  
   Cells(i, 2) = Col(i)  
Next  
 Cells(4, 5) = Timer - Start  
 Cells(4, 6) = Col.Count  
[CalcTime] = Timer - Start
 
End Sub  
 
Sub btnDictionary_Click()  
Dim NewMyArray, MyArray, D  
Start! = Timer  
On Error Resume Next  
Set D = CreateObject("Scripting.Dictionary")  
MyArray = [a1:a12000]
For Each a In MyArray  
 D.Add CStr(a), a  
Next a  
NewMyArray = D.Items  
For i = 0 To UBound(NewMyArray)  
   Cells(i + 1, 2) = NewMyArray(i)  
Next  
 Cells(5, 5) = Timer - Start  
 Cells(5, 6) = UBound(NewMyArray) + 1  
[CalcTime] = Timer - Start
End Sub  
 
Sub filter()  
Start! = Timer  
Range("A1:A12000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets(1).Range("B1"), Unique:=True  
[CalcTime] = Timer - Start
 Cells(6, 5) = Timer - Start  
End Sub  
 
Файл не даю, сильно секретный :)
 
У меня ввод формулы в ячейку листа 14,5 с, "СЧЁТ_РАЗНЫХ_3" 28,9 с. Ровно в 2 раза. Интересно, почему?
 
{quote}{login=Hugo}{date=17.06.2010 02:45}{thema=}{post}{/post}{/quote}  
 
 
не помню с кем мы оттачивали скорость этого алгоритма - точно с ZVI, а вот еще учавствовал или degassad или Anik.. но там было чуточку точнее в конце
Живи и дай жить..
 
По совету слэн'a попробовал ещё подсократить время выполнения СЧЁТ_РАЗНЫХ_2.  
Попытался сначала заменить в цикле в ключе коллекции CStr(tmpArr(i, j)) на tmpArr(i, j):  
If tmpArr(i, j) <> "" Then .Add tmpArr(i, j), tmpArr(i, j)  
заработало. Время уменьшилось почти вдвое : стало 0,047 сек.  
НО возникли сомнения, а С ЛЮБЫМИ ЛИ ТИПАМИ ДАННЫХ это будет корректно работать? Ведь об ошибке работы макроса никак не узнаешь, т.к. включен обработчик ошибок  
Я с коллекциями знаком мало, поэтому и сомневаюсь...  
 
Попытки вместо значения добавлять только ключ:  
 If tmpArr(i, j) <> "" Then .Add "", tmpArr(i, j)  
к ускорению не привели.
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
Страницы: 1 2 След.
Читают тему (гостей: 1)
Наверх