Страницы: 1
RSS
Подсчет уникальных значений в столбце (текст) с помощью макроса
 
Добрый день.
Имеется столбец с названиями. Как при помощи макроса посчитать количество уникальных значений в столбце?
Пытался сделать циклом, но ничего не вышло. Неудавшийся цикл ниже, файл во вложении.
Код
Sub as()
Dim a As Long
Dim b As Long
Dim lastrowdata as long
Dim ch As Integer
lastrowdata= Cells(Rows.count, 1).End(xlUp).Row
ch = 0
For b = 2 To a
  For a = 2 To lastrowData
    If b <> a And Cells(a, 4) <> Cells(b, 4) Then ch = ch + 1
  Next
Next
Cells(lastrowData + 1, 4).Value = ch
End sub
 
Знакома ли Вам эта статья?
Подсчет количества уникальных значений
Если Вы настаиваете на решении при помощи макросов, то попробуйте реализовать на VBA логику работы формул, представленных в статье.
 
Hellmaster, здравствуйте!
Нестареющая классика. Работает в выделенном диапазоне

Цитата
IKor: попробуйте реализовать на VBA логику работы формул
словари не имеют конкуренции на массивах до 100 000 уникальных элементов. Потом начинают проигрывать варианту с предварительной сортировкой  ;)
Реализация же формул в коде будет тупить уже на тысяче…
Изменено: Jack Famous - 09.10.2019 11:28:11 (Добавил Intersect. Теперь можно хоть весь лист выделить — считает очень быстро)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Offtopic:
- Порядок кипячения воды в домашних условиях: 1. Налить воду в чайник; 2. поставить чайник на плиту; 3 зажечь газ
- Если вода в чайнике уже есть и газ горит: то следует вылить воду из чайника, выключить газ - а для этих начальных условий решение задачи приведено выше
 
IKor, спасибо за статью, возьму на вооружение.
Jack Famous,  спасибо за макрос. У меня выдает ошибку user defined type not defined
 
IKor, я не понял вашей аллегории (применительно к данному вопросу)
99% всех задач (разумеется, про макросы) связанных с уникальными значениями решается словарями — это самое простое и эффективное одновременно. Исключений практически нет… Да — есть коллекции, для которых не нужно подключать библу, но в холиваре по сравнению эффективности и универсальности между ними я на стороне словарей.

Цитата
Hellmaster: выдает ошибку
в файле я подключил нужную библиотеку - советую в вашем также сделать. Ну или использовать позднее связывание. Будет медленнее, но разницу вы вряд ли заметите:
    1. замените dic As New Dictionary на dic As Object
    2. добавьте (в строку № 8 например)  Set dic = CreateObject("Scripting.Dictionary")
Изменено: Jack Famous - 09.10.2019 12:33:12
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, спасибо. все работает
 
Hellmaster, пользуйтесь на здоровье и обязательно посмотрите ссылки  ;)

UPD: Разместил тут более универсальный макрос-отчёт
Изменено: Jack Famous - 09.10.2019 16:00:37
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
я не понял вашей аллегории
Для меня макросы - темный лес, на который я смотрю в лучшем случае с опушки...
Поэтому когда другие люди пытаются с их помощью решить задачи, для которых известно решение формулами, то я рекомендую попробовать сначала более простое в реализации решение. Хотя я понимаю, что в конкретных случаях решение с макросами имеет множество преимуществ.
Поэтом прошу мою фразу воспринимать не на свой счет, а применительно к ситуации вообще: принцип поиска решения [формулами] представлен - пользуйтесь; если же его обязательно реализовать в VBA - то я бы пошел таким путем...  
 
Цитата
IKor: Для меня макросы - темный лес … когда другие люди пытаются с их помощью решить задачи, для которых известно решение формулами, то я рекомендую попробовать сначала более простое в реализации решени
    1. простота - понятие относительное, не так ли? В данном случае моё готовое решение в 1 щелчок позволяет получить нужную информацию без доп. столбцов с формулами. Вот мне кажется, что именно так намного быстрее и удобнее (а в расширенной версии по ссылке вообще полноценный отчёт получается)
    2. когда создаётся тема и автор явно указывает, какое решение ему нужно, то приоритет, разумеется, за этим решением. Есть, конечно, вероятность, что он просто не знает, что есть другие варианты или, что другой намного лучше. Короче, никто не запрещает давать другие варианты…
Совсем другое дело, когда вы предлагаете вариант "не по теме" при этом критикуя "уместный". И я бы не назвал эту критику обоснованной, потому что так и не понял, что я сделал не так  :D

Считаю, что дополнительные альтернативные варианты редко бывают лишними и ваша ссылка вполне уместна
Изменено: Jack Famous - 10.10.2019 11:08:34
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
когда вы предлагаете вариант "не по теме" при этом критикуя "уместный".
Пожалуйста, не приписывайте мне действий, которые я не совершал.
Я не предлагал свой вариант - а предложил ознакомиться со статьей из ПРИЕМов до того, как станет понятно займется ли кто-нибудь еще этим вопросом
И уж тем более не критиковал предложенный Вами вариант решения.
А лишь обратил внимание на некоторую схожесть ситуации: вместо прямого пути решения задачи (макросами) к финишу можно добраться, двигаясь по более долгому, но знакомому [мне] пути.
Я еще раз прошу не принимать близко к сердцу мои слова - они относятся к возникшей ситуации!
 
Jack Famous, Добрый вечер! имеется столбец с значениями с помощью кода найденного на этом прекрасном форуме удалось решить задачку по подсчету уникальных значений.
Следующая задача это найти самое часто встречающееся значение. подскажите пожалуйста как сделать? т.е нужно вернуть "по собственному" (не прошу сделать за меня прошу помочь советом или послать меня туда куда копать =) ) но не очень сложно для понимания.
Так же помогите пожалуйста с следующими вопросами:
1) не могу вернуть 1ое значение из словаря т.е обращаясь Debug.print Dic(0) не получаю ничего
Назначая доп. переменную по принципу S = "по собственному"
Debug.print dic(S) не происходит тоже ничего =(
Ответьте пожалуй на вопрос почему не могу вернуть значение из словаря по итему / ключу ?
2) Так же вопрос все таки где хранятся значения в моем случае в Key или в Item? ( на приложенной картинке почему то и там и там О_о)

Код
Sub dd()
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim dic As Object, rng As Range, ar As Range
Dim x, arr

Set dic = CreateObject("Scripting.Dictionary")
    For Each ar In Range(Cells(3, 1), Cells(LastRow, 1))
    arr = ar
    If Len(arr) Then x = dic(arr)
Next ar
Range("B2") = dic.Count
End Sub
Так же вопрос по этой строке "If Len(arr) Then x = dic(arr)" как я понимаю тут подсчитывается кол-во байтов, и если оно совпадает с значением в словаре, то не записывается. Верно? вопрос что за переменная X и почему ее значение всегда равно ПУСТОТЕ.

Заранее спасибо!
Изменено: Oleg OK - 07.02.2023 21:09:33
 
Цитата
Oleg OK написал:
вопрос что за переменная X
на военной кафедре:
пусть количество танков будет Х... нет, мало пусть будет У
с тояки зрения математики и программирования переменная Х НИЧЕМ не отличается от У
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
1) Порядок в словаре не регламентируется, поэтому такой запрос по сути не имеет смысла. Но физически там конечно есть первое значение...
2). keys - ключи, items - значения.

Чтоб найти самое часто встречающееся - можно например записывать в словарь количество повторений ключа, и сразу максимально полученное число запоминать в переменную. Можно с ключём.
Но если таких несколько? Тогда в конце можно пройтись циклом по словарю и всех с таким итемом собрать в массив/коллекцию/лист.
 
Код
Sub dd()
  Dim a, c&, d As Object, r&, rg As Range, m, nm$
  a = Range(Cells(1), Cells(Rows.Count, 1).End(xlUp))
  Set d = CreateObject("Scripting.Dictionary")
  For r = 1 To UBound(a)
    If Len(a(r, 1)) Then
      c = d(a(r, 1)) + 1: d(a(r, 1)) = c
      If c > m Then m = c: nm = a(r, 1)
    End If
  Next
  Range("B2") = nm & " = " & d(nm) & " øò."
  Range("b3").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.items)
  Range("c3").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.keys)
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
написал:
акой запрос по сути не имеет смысла. Но физически там конечно есть первое зна
Спасибо улыбнуло)  ;)  Я понимаю что Х от Y и даже от "И краткой" не отличается ничем) Вопрос что она делает в коде выше. Не могу понять мы считаем длину строки и в переменную Х записываем слово которое сейчас в перебираемой ячейке? О_о  а почему Х всегда пустой, как бы я не бегал по нему пошаговым выполнением макроса =(  
Код
If Len(arr) Then x = dic(arr) 

Простите, что докапываюсь "школьными" вопросами. Справку по лен  и словарю читал / гуглин все равно на голову не налазит все это.
 
Цитата
Hugo: Порядок в словаре не регламентируется
ошибочное заявление. при получении массивов из коллекций ключей и значений словаря они по индексам соответствтвуют друг-другу и порядку добавления в словарь
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1
Наверх