计算并将唯一值存储在一列中

想象一下，我有以下专栏：

2008 2008 2009 2010 2009 

我想在VBA中创build一个代码，首先返回唯一值的总和，在这个例子中：3（2008,2009和2010），我也想将这些单值存储在一个数组中（这是我相信的最好）。

我试过build立一个循环来检查最后一个单元格并比较结果，但是显然还不够

Answer 1

如果您的唯一数据在列A中（例如在您的示例中说A1到A5），那么您可以使用带有字典的变体数组来提取独特

下面的代码

• 在列A中创build一个variables数组X
• testing每个项目以查看它是否存在于字典对象objDic如果不是，则将其添加到字典中，并且将其添加到第二个变体数组Y
• 最后的变体数组Y被转储到B1，并尽可能地延伸（这个数组包含最后的unique加空格代替dupe，如果需要，可以调整它的大小）

（ 更新 ：添加testing忽略空白*）

  Sub GetUniques() Dim X Dim Y Dim objDic As Object Dim lngRow As Long Dim lngCnt As Long Set objDic = CreateObject("Scripting.Dictionary") X = Range([a1], Cells(Rows.Count, "A").End(xlUp)).Value2 ReDim Y(1 To UBound(X, 1), 1 To 1) For lngRow = 1 To UBound(X, 1) If Len(X(lngRow, 1)) > 0 Then If objDic.exists(X(lngRow, 1)) = False Then lngCnt = lngCnt + 1 Y(lngCnt, 1) = X(lngRow, 1) objDic.Add X(lngRow, 1), 1 End If End If Next lngRow [b1].Resize(UBound(Y, 1), 1) = Y End Sub 

版本2

使用根据简单的VBA数组连接不能正常工作

 Sub GetUniques2() Dim X Dim Y Dim objDic As Object Dim lngRow As Long Dim lngCnt As Long Set objDic = CreateObject("Scripting.Dictionary") X = Range([a1], Cells(Rows.Count, "A").End(xlUp)).Value2 ReDim Y(1 To UBound(X, 1)) For lngRow = 1 To UBound(X, 1) If Len(X(lngRow, 1)) > 0 Then If objDic.exists(X(lngRow, 1)) = False Then lngCnt = lngCnt + 1 Y(lngCnt) = X(lngRow, 1) objDic.Add X(lngRow, 1), 1 End If End If Next lngRow ReDim Preserve Y(1 To lngCnt) MsgBox Join(Y, ", ") End Sub 

Answer 2

检查follwingfunction

 Function UniqueItem(InputRange As Range, count As Long) As Variant Dim cl As Range, cUnique As New Collection, cValue As Variant Application.Volatile On Error Resume Next For Each cl In InputRange If cl.Formula <> "" Then cUnique.Add cl.Value, CStr(cl.Value) End If Next cl UniqueItem = "" If count = 1 Then UniqueItem = cUnique.count ElseIf count = 0 Then For i = 1 To cUnique.count If UniqueItem = "" Then UniqueItem = UniqueItem & cUnique(i) ElseIf UniqueItem <> "" Then UniqueItem = UniqueItem & ", " & cUnique(i) End If Next End If On Error GoTo 0 End Function 

以下单元格中的公式将返回由逗号分隔的独特项目

 =UniqueItem(A1:A7,0) 

单元格中的公式将返回所选范围内唯一项目的计数

 =UniqueItem(A1:A7,1) 

如何使用这个function

1. 打开excel文件

2. 按下Alt + F11

3. 创build一个新的模块并粘贴代码

4. 回到excel文件，select你想要的结果的单元格

5. 键入公式as =UniqueItem(A1:A7,0)以返回所选范围内的唯一项目。 （你可以select任何范围）

6. 键入公式as =UniqueItem(A1:A7,1)以返回所选范围内唯一项目的数量。 （你可以select任何范围）