Функция для подсчета различных значений в диапазоне столбцов

Question

Я пытаюсь создать функцию в VBA, которая при задании диапазона значений вернет Count Distinct этих значений. Например:

| Column A | |----------| | 1 | | 2 | | 3 | | 3 | | 3 | | 3 | | 4 | | 4 | | 5 | | 5 | | 6 | Число рядов = 11 различающиеся значения = 6

Вот структура кода VBA Я пытаюсь использовать, чтобы построить функцию я могу позвонить в Excel:

Function CountDistinct(dataRange As Range) 

Dim x As Double 
x = 0 

For i = 1 To dataRange.Rows.Count 

x = x + (1/(CountIf(dataRange, dataRange(i)))) 

Next i 

End Function 

Я совершенно не знаком с программированием VBA, поэтому извиняюсь за все очевидные, вопиющие ошибки, сделанные в коде выше, если его даже можно назвать так.

Я знаю, что есть другие способы найти правильный ответ, но мне интересно узнать, как создавать пользовательские функции Excel.

Кроме того, псевдо-логика моего подхода заключается в следующем:

1. Дайте функцию CountDistinct диапазон ячеек dataRange
2. Loop через диапазон
3. Для каждой ячейки диапазон, выполните COUNTIF по этому значению в диапазоне (поэтому в приведенном выше примере строки 3-6 будут возвращать , так как онемение er 3 появляется 4 раза в диапазоне).
4. Для каждой ячейки в диапазоне, добавьте 1/(результат шага 3) в результате переменной х

| Values | CountIF(Value) | 1/CountIF(Value) | |--------|----------------|-----------------------------| | 1 | 1 | 1 | | 2 | 1 | 1 | | 3 | 4 | 0.25 | | 3 | 4 | 0.25 | | 3 | 4 | 0.25 | | 3 | 4 | 0.25 | | 4 | 2 | 0.5 | | 4 | 2 | 0.5 | | 5 | 2 | 0.5 | | 5 | 2 | 0.5 | | 6 | 1 | 1 | | | | SUM of 1/CountIF(Value) = 6 |

Это будет возвращать граф различных значений в столбце A == 6 .

Answer 1

Первые шаги:
Добавить Option Explicit в заголовок всех модулей. Он зафиксирует разницу между OneVariable и OneVarlable.
Сделайте свои переменные значимыми - знаете ли вы, что я и x были в следующий раз, когда вы смотрите на этот код?

Ваших вариантов для подсчета являются

1. пользователя функция рабочего листа
2. сохранить значения, и рассчитывать только те, которые не соответствуют предыдущим значениям

Использования функции рабочего листа,

Option Explicit 

Function CountUnique(dataRange As Range) As Long 
Dim CheckCell 
Dim Counter As Double 
Counter = 0 

For Each CheckCell In dataRange.Cells 
    Counter = Counter + (1/(WorksheetFunction.CountIf(dataRange, CheckCell.Value))) 
Next 
' Finally, set your function name equal to the Counter, 
' so it knows what to return to Excel 
CountUnique = Counter 
End Function 

Использование дорожки для слежения

... 
' check out scripting dictionaries 
' much more advanced - Keep it simple for now 
... 

Answer 2

Sub CountDistinct() 
    Dim RunSub As Long 
    Dim LastRow As Long 
    Dim CurRow As Long 
    Dim Unique As Long 

     LastRow = Range("A" & Rows.Count).End(xlUp).Row 
     Unique = 1 

     For CurRow = 2 To LastRow 
      If Range("A2:A" & CurRow - 1).Find(Range("A" & CurRow, LookIn:=xlValues)) Is Nothing Then 
      Unique = Unique + 1 
      Else 
      End If 
     Next CurRow 

     MsgBox Unique & " Unique Values" 

End Sub 

Answer 3

Есть (конечно) другие способы, которые это можно сделать с помощью VBA.

Public Function CountDistinct(rng As Range) As Long 
    Dim i As Long 
    Dim Cnt As Double 
    Cnt = 0 
    For i = 1 To rng.Rows.Count 
    Cnt = Cnt + 1/WorksheetFunction.CountIf(rng, rng(i, 1)) 
    Next i 
    CountDistinct = CLng(Cnt) 
End Function 

Answer 4

Я куранты здесь, а также ...

Public Function Count_Distinct_In_Column(Rng As Range) 
    Count_Distinct_In_Column = _ 
    Evaluate("Sum(N(countif(offset(" & Rng.Cells(1).Address _ 
    & ",,,row(" & Rng.Address & "))," & Rng.Address & ")=1))") 
End Function 

Вызывается как:

? Count_Distinct_In_Column(Range("A2:A12")) 

Answer 5

Этот метод применяется следующая логика.

• Поместите элементы диапазона в массив
• Place массив в словарь для уникальных элементов только
• Count элементов (ключей) в словаре уникальных элементов

Под Tools- -> Ссылки, Ссылка «Время выполнения сценариев Microsoft»

Option Explicit 

Dim lngCounter As Long 
Dim dataRange As Range 
Dim dictTemp As Dictionary 
Dim varTemp As Variant 

Sub Test() 

Set dataRange = Range(Cells(2, 1), Cells(12, 1)) 

MsgBox CountDistinct(dataRange), vbInformation + vbSystemModal, "Count Distinct" 

End Sub 

Public Function CountDistinct(dataRange As Range) As Long 

'Populate range into array 
If dataRange.Rows.Count < 2 Then 
    ReDim varTemp(1 To 1, 1 To 1) 
    varTemp(1, 1) = dataRange 
Else 
    varTemp = dataRange 
End If 

'Dictionaries can be used to store unique keys into memory 
Set dictTemp = New Dictionary 

'Add array items into dictionary if they do not exist 
For lngCounter = LBound(varTemp) To UBound(varTemp) 
    If dictTemp.Exists(varTemp(lngCounter, 1)) = False Then 
     dictTemp.Add Key:=varTemp(lngCounter, 1), Item:=1 
    End If 
Next lngCounter 

'Count of unique items in dictionary 
CountDistinct = dictTemp.Count 

End Function 

Answer 6

В Excel 2013 используйте Distin ct Count в сводной таблице.

Answer 7

Поздно вечером, но я думал, что поставлю еще один вариант VBA, который не требует добавления ссылки.

Кроме того, это касается опрятной функции Excel VBA, которую я хотел бы узнать намного раньше.

Мое решение для этого использует объект Collection, чтобы найти различные значения.

Option Explicit 
'^ As SeanC said, adding Option Explicit is a great way to prevent writing errors when starting out. 
Public Function CountDistinct(r As Range) As Long 
'' DIM = declare in memory 

Dim col As Collection 
Dim arr As Variant 
Dim x As Long 
Dim y As Long 

Set col = New Collection 
'' setting a Variant = Range will fill the Variant with a 2 dimensional array of the values of the range! 
arr = r 
'' skip the errors that are raised 
On Error Resume Next 
'' loop over all of the elements. 
'' UBound is a built in VBA Function that gives you the largest value of an array. 
    For x = 1 To UBound(arr, 1) 
     For y = 1 To UBound(arr, 2) 
      '' try to add the value in arr to the collection 
      col.Add 0, CStr(arr(x, y)) 

      '' every time the collection runs into a value it has already added, 
      '' it will raise an error. 
      'uncomment the below to see why we are turning off errors 
      'Debug.Print Err.Number, Err.Description 

     Next 
    Next 
'' turn errors back on. 
On Error GoTo 0 
''set the function name to the value you want the formula to return 
CountDistinct = col.Count 
'' The next parts should be handled by VBA automatically but it is good practise to explicitly clean up. 
Set col = Nothing 
Set arr = Nothing 
Set r = Nothing 
End Function 

Я надеюсь, что это поможет кому-то по линии.