vba - For Each loop on 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公式
首先，将高级过滤器应用于您的列(数据->过滤器->高级)。在这里，选择“复制到另一个位置”，选择您的数据范围(如“列表范围”)，您的目的地(“复制到”)并仅选中“唯一值”。
现在使用该唯一列表，在下一列中添加一个 COUNTIF 公式。

3. VBA

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

Sub CountUnique(rngInput As Range, rngTarget As Range)

暗淡为新词典
将 varCell 调暗为变体
将 varKey 调暗为变体
调光为范围
对于 rngInput 中的每个 varCell
If Not d.Exists(varCell.Value) Then
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)
下一个

结束子