Question

我正在尝试在VBA中创建一个函数，当给定一系列值时，它将返回这些值的Count Distinct。例如：

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

以下是我试图用来构建我可以在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

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

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

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

为函数 CountDistinct 提供一系列单元格 dataRange
遍历范围
对于范围内的每个单元格，在整个范围内对该值执行 COUNTIF （因此在上面的示例中，第3-6行将各自返回 4 ，因为数字3在范围内出现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 |

这将返回A列中的Count of Distinct值== 6.

Answer 1

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

您的计数选项是

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

使用工作表功能

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

参加派对的方式很晚，但我想我会添加另一个不需要添加引用的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

我希望这有助于某些人下线。

Answer 3

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 4

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

我也会来这里...

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

6

Answer 6

此方法应用以下逻辑。

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

在工具 - ＆gt;参考文献中，参考“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

Answer 7

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

用于计算列范围中的不同值的函数

7 个答案: