VBA 如何统计一列中每一个数据出现的次数，并在另外两列中分别显示数据名称和次数。 注：用VBA

Question

如题所述

Answer 1

使用字典实现，例如统计A列数据显示在C、D列的代码如下：

set db=createobject("scripting.dictionary")
for i=1 to activesheet.usedrange.rows.count
    x=trim(cells(i,1))
    db(x)=db(x)+1
next i
i=1
for each x in db.keys
    cells(i,3)=x
    cells(i,4)=db(x)
    i=i+1
next k

Answer 2

Sub TongJi()
    Dim Rng0 As Range
    Dim Rng1 As Range
    Dim Ri
    Dim i As Long
    Dim D 
    Set Rng0 = Range("A1:A100")  '此处A1：A100为统计的范围
    Set Rng1 = Range("D1") '此处D1为存放结果数据的最左上角单元格
    Set D = CreateObject("Scripting.Dictionary")
    For Each Ri In Rng0
        D((Ri)) = GetV(D((Ri))) + 1
    Next
    For i = 0 To UBound(D.Keys())
        Rng1.Offset(i, 0) = D.Keys(i)
        Rng1.Offset(i, 1) = D.Items(i)
    Next
End Sub

Function GetV(S As String)
    If S = "" Then GetV = 0 Else GetV = CLng(S)
End Function

Answer 3

sub test()
    '假设数据在A列，结果在B、C列
    dim dic as object
    set dic=createobject("scription.dictionary")
    arr=range([A1],[A65536].end(xlup))
    for i=1 to ubound(arr,1)
        if arr(i,1)<>"" then dic(arr(i,1))=dic(arr(i,1))+1
    next
    [b1].resize(dic.count,1)=application.transpose(dic.keys)
    [c1].resize(dic.count,1)=application.transpose(dic.items)
end sub

追问

追答sub test()
    '假设数据在A列，结果在B、C列
    dim dic as object
    set dic=createobject("scripting.dictionary")'拼错了。。。
    arr=range([A1],[A65536].end(xlup))
    for i=1 to ubound(arr,1)
        if arr(i,1)<>"" then dic(arr(i,1))=dic(arr(i,1))+1
    next
    [b1].resize(dic.count,1)=application.transpose(dic.keys)
    [c1].resize(dic.count,1)=application.transpose(dic.items)
end sub

本回答被网友采纳

Answer 4

提取次数
application.countif()

提取不重复数据
range("a1:a65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True追问

这不还是引用表格函数吗？