对于Array上的每个循环来返回每个唯一string的计数

我想要实现的是返回一列中的唯一值（string）。 把这个列表放到一个数组中，然后将这个值列表粘贴到一个新的表格中，例如列A中。然后，对于每个数组元素，计算它发生原始列表的次数，并返回新列表中列B中的频率计数其独特的string。

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

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.创build唯一值列表并添加COUNTIF公式首先，将高级筛选应用于您的列（数据 – >筛选 – >高级）。 在这里，select“复制到其他位置”，select您的数据范围（如“列表范围”），您的目的地（“复制到”），并选中“唯一值”。 现在使用该唯一列表，在下一列中添加一个COUNTIF公式。

3. VBA

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

 Sub CountUnique（rngInput As Range，rngTarget As Range）

    昏暗的d作为新的词典
     Dim varCell As Variant
     Dim varKey As Variant
    昏暗rngOut作为范围
    对于rngInput中的每个varCell
        如果不是d.Exists（varCell.Value）那么
             d.Add varCell.Value，0＆
        万一
         d（varCell.Value）= d（varCell.Value）+ 1
    下一个

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

结束小组