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

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

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

这里是我试图用来build立一个函数，我可以在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编程完全陌生，因此对于上面代码中所有明显的，明显的错误表示歉意，如果甚至可以这样调用的话。

我知道还有其他的方法来得到正确的答案，但是我有兴趣学习如何创build自定义的Excel函数。

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

1. 给CountDistinct函数的一个范围dataRange函数
2. 在范围内循环
3. 对于范围内的每个单元格，在整个范围内对该值执行一个COUNTIF （所以在上例中，3-6行将返回4 ，因为数字3在该范围内出现4次）。
4. 对于范围中的每个单元格，将1 /（步骤3的结果）添加到结果variablesx中

| 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之间的差异。
让你的variables有意义 – 你会知道下一次你看这个代码时x和我是什么吗？

你的select数量是

1. 使用工作表function
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

晚会的方式，但我想我会把另一个VBA选项，不需要添加引用。

另外，这也涉及到了Excel VBA的一个整洁的function，我希望我早些时候学习。

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

此方法应用以下逻辑。

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

在工具 – >参考下，参考“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 7

在Excel 2013中，使用数据透视表中的区别计数。