1

我想要实现的是返回列中唯一值（字符串）的列表。将该列表放入一个数组中，然后将值列表粘贴到一个新工作表中，例如列 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
4

1 回答 1

5

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

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)
    下一个

结束子
于 2013-01-14T13:44:59.553 回答