Question

想象我有以下专栏：

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

我已经尝试构建一个循环来检查最后一个单元格并比较结果，但这显然不够......

Answer 1

如果您的唯一数据位于A列（在您的示例中为A1到A5），那么您可以使用带有字典的变量数组来提取唯一身份

以下代码

使用A列中的5个值创建变体数组X
测试每个项目以查看它是否存在于字典对象objDic中（如果没有添加到字典中）和第二个变体数组Y
最终变量数组Y被转储到B1，只要有必要（此数组包含末尾的uniques加空格代替dupes，如果需要可以调整大小）

（已更新：添加测试以忽略空白*）

    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

enter image description here

版本2

根据Simple VBA array join not working

使用Join

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

查看以下功能

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)

如何使用此功能

打开Excel文件
按Alt + F11
创建一个新模块并将代码粘贴到其中
返回excel文件并选择要获得结果的单元格
键入公式为=UniqueItem(A1:A7,0)以返回所选范围内的唯一项目。（您可以选择任何范围）
键入公式为=UniqueItem(A1:A7,1)以返回所选范围内的唯一项目数。（您可以选择任何范围）

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

2 个答案:

版本2