logo标签列表

在Excel中计算唯一值数量

excelvbaexcel-formula
14

我需要在Excel中计算范围（C2:C2080）中的唯一值。找到的公式：

=SUM(IF(FREQUENCY(MATCH(C2:C2080;C2:C2080;0);MATCH(C2:C280;C2:C2080;0))>0;1))

返回错误的值。

更新： 糟糕的解决方案：

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
11个回答
26
这是一个对我而言可行的 VBA 函数。
你可以将其用作 工作表函数，引用任何范围，例如“=CountUnique(N8:O9)”。
它处理文本和数字值，并将空单元格视为一个值。
它不需要处理数组函数。
它需要对 Microsoft Scripting Library 的dictionary object进行引用。
    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
你好，是否可以添加条件参数？就像“countifs”函数一样。谢谢！ - dofine
9

=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/zh-cn/excel/HP030561181033.aspx

您也可以编写一个 VBA 宏（不确定这是否是您想要的）。具体操作如下（假设有一个已填充 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
对我不起作用，但我已经成功地从您的代码中创建了一个好的版本。谢谢。 - dayan
该公式是一个数组公式。保存时请按 CTRL + SHIFT + ENTER，而不是仅按 ENTER。 - ChrisB
8

尝试：

=SUM(IF(FREQUENCY(C2:C2080,C2:C2080)>0,1))

编辑： 上述公式可以处理列中的空白条目。

1
尝试这个时，它只会给我一个0作为答案。 - Mike
8

JustinG的功能非常好用（而且快速），直到唯一项目数超过32,767，由于Excel中的某种限制而无法继续使用。

我发现如果您修改他的代码

Public Function CountUnique(rng As Range) As Integer

并使其成为...

Public Function CountUnique(rng As Range) As Long

它将处理更多独特的项目。

7

如果您仍然试图使用@JustinG的字典方法，但是您正在使用较新版本的VBA，则需要稍微更改代码。

您需要引用“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
1
对于那些不知道的人：要引用“Microsoft Scripting Runtime”，请进入您的VBA项目，单击工具 -> 引用... -> 选中“Microsoft Scripting Runtime”复选框。 - Axel
2

阅读此内容后，进一步调查后，我发现有一个比这里所有方法都有效的方法：

数组输入：
（使用Ctrl+Shift+Enter，并且不包括花括号）

{=SUM(IFERROR(1/COUNTIF(C2:C2080,C2:C2080),0))}

或者在 VBA 中：

MyResult = MyWorksheetObj.Evaluate("=SUM(IFERROR(1/COUNTIF(C2:C2080,C2:C2080),0))")

它适用于数字和文本，处理空单元格，处理引用单元格中的错误，并且在VBA中运行。它也是我见过的最紧凑的解决方案之一。在VBA中使用它时，它显然自动处理成为数组公式的需要。
请注意，它处理错误的方式是简单地将它们包含在唯一值计数中。例如，如果您有两个单元格返回#DIV/0!和三个单元格返回#VALUE!，那么这5个单元格将使最终唯一值计数增加2。如果要完全排除错误，则需要进行修改。
在我的测试中，Jacob提供的方法仅适用于数字而不是文本，并且不处理引用单元格中的错误（如果任何引用单元格返回错误，则返回错误）。
=SUM(IF(FREQUENCY(G4:G29,G4:G29)>0,1))
2
请看https://excelchamps.com/blog/count-unique-values-excel/。 那里有最初的回答。
你需要输入的公式是：
=SUMPRODUCT(1/COUNTIF(C2:C2080,C2:C2080))

当您将此公式作为数组输入时，它的样子大概是这样的：

Original Answer

转换成 "最初的回答"。
{=SUMPRODUCT(1/COUNTIF(C2:C2080,C2:C2080))}
1

这个公式对我来说管用。有一些因素可能导致它不起作用。首先，所有目标单元格都必须有一个值。另一个例子是，如果您有一个单元格的值为31，而另一个单元格的文本值为“31”，那么它将把它们识别为不同的值。

您可以尝试这个：

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

这是一个数组公式。你不能只按回车键来确认它，而必须按下ctrl+shift+enter。

这来自于：

http://www.cpearson.com/excel/Duplicates.aspx

1
另一种方法是这样做：

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

您只需要将活动单元格置于要计数的列的第一行。

1

这可能是处理大量行的更有效的方法。它使用内置的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
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接