vba 计算列范围内不同值的函数

Function to count distinct values in a column range

提问by user1408914

I am attempting to create a function in VBA that, when given a range of values, will return a Count Distinct of those values. For example:

我试图在 VBA 中创建一个函数，当给定一个值范围时，它将返回这些值的计数差异。例如：

| Column A | |----------| | 1 | | 2 | | 3 | | 3 | | 3 | | 3 | | 4 | | 4 | | 5 | | 5 | | 6 | Count of Rows = 11 Distinct values = 6

| Column A | |----------| | 1 | | 2 | | 3 | | 3 | | 3 | | 3 | | 4 | | 4 | | 5 | | 5 | | 6 | 行数 = 11 不同值 = 6

Here is the structure of the VBA code I'm trying to use to build a function I can call in Excel:

这是我试图用来构建可以在 Excel 中调用的函数的 VBA 代码的结构：

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

I'm completely new to VBA programming, so apologies for all of the obvious, glaring mistakes made in the code above, if it can even be called that.

我对 VBA 编程完全陌生，所以对上面代码中所有明显的、明显的错误表示歉意，如果它甚至可以被称为。

I know there are other ways to arrive at the correct answer, but I'm interested in learning how to create custom Excel functions.

我知道还有其他方法可以得出正确答案，但我对学习如何创建自定义 Excel 函数很感兴趣。

Also, the pseudo-logic behind my approach is as follows:

此外，我的方法背后的伪逻辑如下：

1. Give the function CountDistincta range of cells dataRange
2. Loop through the range
3. For each cell in the range, perform a COUNTIFon that value across the range (so in the example above, rows 3-6 would each return 4, since the number 3 appears 4 times in the range).
4. For each cell in the range, add 1/(the result of step 3) to the result variable x

1. 给函数CountDistinct一个单元格范围dataRange
2. 循环遍历范围
3. 对于范围内的每个单元格，对该范围内的该值执行COUNTIF（因此在上面的示例中，第 3-6 行将分别返回4，因为数字 3 在该范围内出现了 4 次）。
4. 对于范围内的每个单元格，将 1/（步骤 3 的结果）添加到结果变量 x

| 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 |

| 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 |

This will return the Count of Distinct values in column A == 6.

这将返回 A == 6 列中的不同值计数。

回答by SeanC

First Steps:
Add Option Explicitto the header of all your modules. It will capture the difference between OneVariableand OneVarlable.
Make your variables meaningful - will you know what x and i were for next time you look at this code?

第一步：
添加Option Explicit到所有模块的标题中。这将捕获的区别OneVariable和OneVarlable。
让你的变量有意义——下次你看这段代码时，你会知道 x 和 i 是什么吗？

Your options for the count are

您的计数选项是

1. user the worksheet function
2. save the values, and only count those that don't match previous values

1. 使用工作表功能
2. 保存值，只计算那些与以前的值不匹配的值

Using the worksheet function,

使用工作表功能，

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

Using the keeping track

使用跟踪

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

回答by Jaragoth

Way late to the party, but I thought I would put in another VBA option that does not require adding a reference.

聚会迟到了，但我想我会加入另一个不需要添加引用的 VBA 选项。

In addition this touches on a neat function of excel VBA that I wish I had learn much earlier.

此外，这涉及到我希望我早点学到的 excel VBA 的一个简洁功能。

My solution to this uses the Collection object in order to find distinct values.

我的解决方案使用 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

I hope this helps someone down the line.

我希望这可以帮助某人下线。

回答by Chrismas007

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

回答by Ben1344

There are (of course) other ways this could be done with VBA.

（当然）还有其他方法可以用 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

回答by tbur

I'll chime in here as well...

我也会在这里插话...

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

Called like:

调用如下：

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

6

6

回答by bilbo_strikes_back

This method applies the following logic.

此方法应用以下逻辑。

• Place the range elements into an array
• Place the array into a dictionary for unique elements only
• Count the elements (keys) in the dictionary for unique elements

• 将范围元素放入数组
• 将数组放入仅用于唯一元素的字典中
• 计算字典中唯一元素的元素（键）

Under Tools-->References, Reference "Microsoft Scripting Runtime"

在工具--> 参考下，参考“Microsoft Scripting Runtime”

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

回答by pnuts

In Excel 2013, use Distinct Count in a PivotTable.

在 Excel 2013 中，在数据透视表中使用不同计数。