对于Array上的每个循环，返回每个唯一字符串的计数

Question

我想要实现的是在列中返回唯一值（字符串）的列表。将该列表放入一个数组中，然后将值列表粘贴到一个新表中，如A列。 然后为每个数组元素计算它发生原始列表的次数，并将新表中B列中其频率的计数与其唯一字符串相对应。

到目前为止，这是我的代码。

Sub UniqueList()
Dim rListPaste As Range
Dim causeList As Range
Dim iReply As Integer
Dim element As Variant

On Error Resume Next

Set rListPaste = Application.InputBox _
(Prompt:="Please select the destination cell", Type:=8)

    If rListPaste Is Nothing Then
       iReply = MsgBox("No range nominated," _
          & " terminate", vbYesNo + vbQuestion)
      If iReply = vbYes Then Exit Sub
    End If


causeList = Range("E1", Range("E65536").End(xlUp))
Range("causeList").AdvancedFilter Action:=xlFilterCopy, Unique:=True
Range("causeList").AdvancedFilter CopyToRange:=causeList.Cells(1, 1)

element = 0
For Each element In causeList
    element = element + 1
Next element
End


End Sub

Answer 1

有多种方法可以实现您的目标：

<强> 1。使用数据透视表：

只需为您的数据范围插入数据透视表。删除您感兴趣的字段（列名称） - 行字段和数据字段。您将看到一个独特项目列表及其旁边的计数。如果数据发生更改，则需要刷新数据透视表

<强> 2。创建唯一值列表并添加COUNTIF公式 首先，将高级过滤器应用于您的列（Data-＆gt; Filter-＆gt; Advanced）。在这里，选择“复制到另一个位置”，选择您的数据范围（作为“列表范围”），目的地（“复制到”）并仅选中“唯一值”。 现在使用该唯一列表，在下一列中添加COUNTIF公式。

第3。 VBA

以下代码将输出唯一值列表及其频率。您需要添加对“Microsoft Scripting Library”的引用，因为它使用Dictionary对象：

Sub CountUnique(rngInput As Range, rngTarget As Range)

    Dim d As New Dictionary
    Dim varCell As Variant
    Dim varKey As Variant
    Dim rngOut As Range
    For Each varCell In rngInput
        If Not d.Exists(varCell.Value) Then
            d.Add varCell.Value, 0&
        End If
        d(varCell.Value) = d(varCell.Value) + 1
    Next

    Set rngOut = rngTarget(1, 1)
    For Each varKey In d.Keys
        rngOut.Value = varKey
        rngOut.Offset(, 1) = d(varKey)
        Set rngOut = rngOut.Offset(1)
    Next

End Sub