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

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公式 首先，将“高级过滤器”应用于您的列（“数据”->“过滤器”->“高级”）。在这里，选择“复制到另一个位置”，选择数据范围（作为“列表范围”），目的地（“复制到”）并仅选中“唯一值”。现在有了该唯一列表，在下一列中添加一个COUNTIF公式。

3. VBA

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

Sub CountUnique（rngInput作为范围，rngTarget作为范围）

    昏暗的新字典
    Dim varCell作为变体
    昏暗的varKey作为变体
    调光范围
    对于rngInput中的每个varCell
        如果不是d.Exists（varCell.Value）然后
            d。添加varCell.Value，0
        万一
        d（varCell.Value）= d（varCell.Value）+ 1
    下一个

    设置rngOut = rngTarget（1，1）
    对于d.Keys中的每个varKey
        rngOut.Value = varKey
        rngOut.Offset（，1）= d（varKey）
        设置rngOut = rngOut.Offset（1）
    下一个

结束子