我想使用VBA获取列中数据的频率 [英] i want to get the frequency of a data in a column using vba

问题描述

我尝试使用字典，但它只计算重复次数，但我想知道一列中所有数据的确切频率
香港专业教育学院使用的是

i tried using dictionary but it only counts the repetition but i want to know the exact frequency of all datas in a column
what ive used is

Sub countThings()

Dim ws As Worksheet
Dim lastrow As Long, x As Long
Dim items As Object

Application.ScreenUpdating = False

Set ws = ActiveSheet

lastrow = ws.Range("B" & Rows.count).End(xlUp).Row

Set items = CreateObject("Scripting.Dictionary")
For x = 2 To lastrow
If Not items.exists(ws.Range("B" & x).Value) Then
items.Add ws.Range("B" & x).Value, 1
ws.Range("C" & x).Value = items(ws.Range("B" & x).Value)
Else
items(ws.Range("B" & x).Value) = items(ws.Range("B" & x).Value) + 1
ws.Range("C" & x).Value = items(ws.Range("B" & x).Value)
End If
Next x
items.RemoveAll

End Sub

这给了我[

但是我需要的是

[ 4 :推荐答案

我认为这是您追求的目标.请尝试.

I think this is what you were after. Please try it.

Sub CountThings()

    Dim Ws          As Worksheet
    Dim Items       As Object           ' Scripting.Dictionary
    Dim Arr         As Variant          ' values in column B
    Dim R           As Long             ' loop couner: Rows
    Dim Key         As Variant          ' loop counter: dictionary keys
    
    Set Items = CreateObject("Scripting.Dictionary")
    
    Set Ws = ActiveSheet                ' better: define tab by name
    With Ws
        ' reading from the sheet is slow
        ' therefore read all items at once
        Arr = .Range(.Cells(2, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value
        ' this is a 1-based 2-D array, like Arr([Rows], [Column])
        ' where column is always 1 because there's only 1 column
    End With
        
    For R = 1 To UBound(Arr)
        If Items.Exists(Trim(Arr(R, 1))) Then
            Items(Trim(Arr(R, 1))) = Items(Trim(Arr(R, 1))) + 1
        Else
            Items.Add Trim(Arr(R, 1)), 1
        End If
    Next R
    
    ReDim Arr(1 To Items.Count, 1 To 2)
    R = 0
    For Each Key In Items.keys
        R = R + 1
        Arr(R, 1) = Key
        Arr(R, 2) = Items(Key)
    Next Key
    
    ' specify the top left cell of the target range
    Ws.Cells(2, "C").Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
    Set Items = Nothing
End Sub

如果您确定没有任何杂散的前导或尾随空格，则无需修剪按键.

You need not Trim the Keys if you are sure that there can't be any stray leading or trailing blanks.

您的第二张图片不需要VBA.可以通过此公式生成，输入C2并向下复制.

Your second picture doesn't need VBA. It can be produce by this formula, entered in C2 and copied down.

=COUNTIF($B$2:$B$13,$B2)

实际上，您甚至可以在没有VBA的情况下完成我上面的代码.在工作表的G2中输入此公式作为数组公式(如果没有Excel 365，请通过CTL + SHIFT + ENTER确认)，然后在H中输入另一个公式.然后向下复制两个公式.

In fact, you can even do the job of my above code without VBA. Enter this formula in G2 of your sheet as an array formula (confirmed with CTL + SHIFT + ENTER if you don't have Excel 365), and the other one in H. Then copy both formulas down.

[G2] =IFERROR(INDEX($B$2:$B$13, MATCH(0, COUNTIF($G$1:G1, $B$2:$B$13), 0)), "")
[H2] =IF($G2<>"",COUNTIF($B$2:$B$13,$G2),"")

这篇关于我想使用VBA获取列中数据的频率的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！