vba 计算 Excel 中的唯一值
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/1676068/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Count unique values in Excel
提问by dayan
I need to count unique values in range (C2:C2080) in excel. Googled formula:
我需要在excel中计算范围（C2：C2080）中的唯一值。谷歌公式：
=SUM(IF(FREQUENCY(MATCH(C2:C2080;C2:C2080;0);MATCH(C2:C280;C2:C2080;0))>0;1))
return incorrect value.
返回错误的值。
UPD: Lame solution:
UPD：跛脚解决方案：
Sub CountUnique()
Dim i, count, j As Integer
count = 1
For i = 1 To 470
flag = False
If count > 1 Then
For j = 1 To count
If Sheet1.Cells(i, 3).Value = Sheet1.Cells(j, 11).Value Then
flag = True
End If
Next j
Else
flag = False
End If
If flag = False Then
Sheet1.Cells(count, 11).Value = Sheet1.Cells(i, 3).Value
count = count + 1
End If
Next i
Sheet1.Cells(1, 15).Value = count
End Sub
采纳答案by Jacob
=SUM(IF(FREQUENCY(IF(LEN(A2:A10)>0,MATCH(A2:A10,A2:A10,0),""), IF(LEN(A2:A10)>0,MATCH(A2:A10,A2:A10,0),""))>0,1))
http://office.microsoft.com/en-us/excel/HP030561181033.aspx
http://office.microsoft.com/en-us/excel/HP030561181033.aspx
You may also write a VBA macro (not sure if that's what you're after though.)
你也可以写一个 VBA 宏（但不确定这是否是你想要的。）
Something to the effect of (given a spreadsheet with A1-A11 filled and B1-B11 empty):
效果如下（给定一个 A1-A11 填充且 B1-B11 为空的电子表格）：
Sub CountUnique()
Dim count As Integer
Dim i, c, j As Integer
c = 0
count = 0
For i = 1 To 11
Sheet1.Cells(i, 2).Value = Sheet1.Cells(i, 1).Value
c = c + 1
For j = 1 To c
If CDbl(Sheet1.Cells(i, 1).Value) = CDbl(Sheet1.Cells(j, 2).Value) Then
c = c - 1
Exit For
End If
Next j
Next i
' c now equals the unique item count put in the 12'th row
Sheet1.Cells(12, 1).Value = c
End Sub
回答by JustinG
Here is a VBA function that works for me.
这是一个对我有用的 VBA 函数。
You can use it as a worksheet function, referencing any range, eg “=CountUnique(N8:O9)”
您可以将其用作工作表函数，引用任何范围，例如“=CountUnique(N8:O9)”
It handles text and numeric values, and treats blank cells as one value
它处理文本和数字值，并将空白单元格视为一个值
It does not require dealing with array functions.
它不需要处理数组函数。
It requires a reference to the Microsoft Scripting Library, for the dictionary object.
对于字典对象，它需要对 Microsoft 脚本库的引用。
Public Function CountUnique(rng As Range) As Integer
Dim dict As Dictionary
Dim cell As Range
Set dict = New Dictionary
For Each cell In rng.Cells
If Not dict.Exists(cell.Value) Then
dict.Add cell.Value, 0
End If
Next
CountUnique = dict.Count
End Function
回答by Jacob
Try:
尝试：
=SUM(IF(FREQUENCY(C2:C2080,C2:C2080)>0,1))
=SUM(IF(FREQUENCY(C2:C2080,C2:C2080)>0,1))
EDIT:The above willhandle blank entries in the column
编辑：以上将处理列中的空白条目
回答by Jim D
JustinG's function works very well (and fast) until the number of unique items exceeds 32,767 due to some type of limit in Excel.
由于 Excel 中的某种类型的限制，JustinG 的函数运行得非常好（而且很快），直到唯一项目的数量超过 32,767。
I found if you modify his code
我发现如果你修改他的代码
Public Function CountUnique(rng As Range) As Integer
and make it as...
并使其成为...
Public Function CountUnique(rng As Range) As Long
It will then handle more unique items.
然后它将处理更多独特的项目。
回答by Jordan
For anyone still trying to use @JustinG's dictionary method, you will need to alter the code slightly if you're using a newer version of VBA.
对于仍在尝试使用@JustinG 的字典方法的任何人，如果您使用的是较新版本的 VBA，则需要稍微更改代码。
You'll need to reference 'Microsoft Scripting Runtime' and prefix the Dictionaryterms with Scripting, as follows:
您需要引用“Microsoft Scripting Runtime”并在Dictionary术语前加上前缀Scripting，如下所示：
Public Function CountUnique(rng As Range) As Long
Dim dict As Scripting.Dictionary
Dim cell As Range
Set dict = New Scripting.Dictionary
For Each cell In rng.Cells
If Not dict.Exists(cell.Value) Then
dict.Add cell.Value, 0
End If
Next
CountUnique = dict.Count
End Function
回答by Mathias
You could also simply use a filter to temporarily display unique values, and count the filtered values.
您也可以简单地使用过滤器来临时显示唯一值，并对过滤后的值进行计数。
回答by Greg Lovern
After reading through this and then investigating further, I've got one that works better for me than anything I see here:
通读本文并进一步调查后，我得到了一个比我在这里看到的任何东西都更适合我的方法：
Array-enter:
(Ctrl+Shift+Enter, and don't include the curly brackets)
数组输入：
（Ctrl+Shift+Enter，不包括大括号）
{=SUM(IFERROR(1/COUNTIF(C2:C2080,C2:C2080),0))}
Or in VBA:
或者在 VBA 中：
MyResult = MyWorksheetObj.Evaluate("=SUM(IFERROR(1/COUNTIF(C2:C2080,C2:C2080),0))")
It works for both numbers and text, it handles blank cells, it handles errors in referenced cells, and it works in VBA. It's also one of the most compact solutions I've seen. Using it in VBA, it apparently automatically handles the need to be an array formula.
它适用于数字和文本，处理空白单元格，处理引用单元格中的错误，并且适用于 VBA。这也是我见过的最紧凑的解决方案之一。在 VBA 中使用它，它显然会自动处理成为数组公式的需要。
Note, the way it handles errors is by simply including them in the count of uniques. For example, if you have two cells returning #DIV/0! and three cells returning #VALUE!, those 5 cells would add 2 to the final count of unique values. If you want errors completely excluded, it would need to be modified for that.
请注意，它处理错误的方式是简单地将它们包含在唯一值计数中。例如，如果您有两个单元格返回 #DIV/0! 和三个单元格返回 #VALUE!，这 5 个单元格会将 2 添加到唯一值的最终计数。如果您希望完全排除错误，则需要为此进行修改。
In my tests, this one from Jacob above only works for numbers, not text, and does not handle errors in referenced cells (returns an error if any of the referenced cells returns an error):
在我的测试中，上面来自 Jacob 的这个仅适用于数字，不适用于文本，并且不处理引用单元格中的错误（如果任何引用单元格返回错误，则返回错误）：
=SUM(IF(FREQUENCY(G4:G29,G4:G29)>0,1))
回答by Dan
The formula works for me. There are a few things that could cause this to not work. First, all target cells must have a value in them. Another example of where this might not work is if you have one cell with the value 31 and another cell with a text value of "31". It will recognize these as different values.
这个公式对我有用。有一些事情可能会导致这不起作用。首先，所有目标单元格中都必须有一个值。这可能不起作用的另一个示例是，如果您有一个值为 31 的单元格和另一个文本值为“31”的单元格。它会将这些识别为不同的值。
You could try this:
你可以试试这个：
=SUM(IF(FREQUENCY(IF(LEN(B2:B11)>0,MATCH(B2:B11,B2:B11,0),""), IF(LEN(B2:B11)>0,MATCH(B2:B11,B2:B11,0),""))>0,1))
This is an arrayformula. Instead of hitting just enter to confirm it you must hit ctrl+shift+enter.
这是一个数组公式。您必须按 ctrl+shift+enter 键，而不是按 Enter 键进行确认。
Which is from:
来自：
回答by Neil
This might be a more efficient way of dealing with a large number of rows. This uses the inbuilt AdvancedFilter command instead of cycling through each cell at a time.
这可能是处理大量行的更有效方法。这使用内置的 AdvancedFilter 命令，而不是一次循环遍历每个单元格。
Public Function UniqueValues(oRange As Range) As Variant
' Uses the built-in AdvancedFilter Excel command to return the unique values onto the Worksheet
' and then populate and retuns an array of unique values
' Note: The index:0 element in the returned array will be the header row.
' You can ignore this element unless the first row in your oRange is a unique value
' in which case the header will be that value.
Dim oTarget As Range
Dim r As Long, numrows As Long
Dim vs1, vs2 As Variant
' Get the first unused cell on the first row where the unique vaues will be temporarily populated
Set oTarget = oRange.SpecialCells(xlLastCell) ' the last cell on the worksheet
Set oTarget = oTarget.Parent.Cells(1, oTarget.Column + 1) ' the first unused cell on the first row
' Copy the unique values from your oRange to the first unused cell on row 1
oRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=oTarget, Unique:=True
' Get the number of rows including the first row which is the header
numrows = WorksheetFunction.CountA(oTarget.EntireColumn)
' create an 2-dim array of the rows
vs1 = oTarget.Resize(numrows)
' Prepare a second 1-dim array for the result
ReDim vs2(numrows)
' Transfer the 2-dim array into the 1-dim array
For r = 1 To UBound(vs1, 1)
vs2(r - 1) = vs1(r, 1)
Next
' Return the 1-dim array as the function result
UniqueValues = vs2
' Clean up the extra column on the worksheet
oTarget.EntireColumn.Delete
End Function
回答by Mike
Another way to do this is this:
另一种方法是这样的：
Sub CountUnique()
Dim Count, x, a, lastRow, Values(), StringValues
a = ActiveCell.Column
a = GetLetterFromNumber(a)
lastRow = Range(a & Rows.Count).End(xlUp).row
Count = 0
For Each c In Range(Range(a & "1"), Range(a & Rows.Count).End(xlUp))
If c.row = 1 Then
ReDim Values(lastRow)
Values(Count) = c.Value
Count = Count + 1
End If
StringValues = Join(Values, "#")
StringValues = "#" + StringValues
If InStr(1, StringValues, c.Value) = 0 Then
Values(Count) = c.Value
Count = Count + 1
End If
Next c
MsgBox "There are " & Count & " unique values in column " & a
End Sub
You just have to have the active cell be on row 1 of the column that you are counting.
您只需要让活动单元格位于您正在计数的列的第 1 行。
