VBA code to count occurence

2019-09-06 18:53发布

I have column A which has some element I need to count the occurence and paste in column D & E with name and count respectively.
Since the elements in column A varies, I am unable to use the VBA code which I got for recording a Pivot Table.
Can anyone please Help me with this?

Name            Name    Count  
A                  A    5
A                  B    3
A                  C    1
A                  D    1
B               
B               
C               
B               
D               
A   

This is what I tried :-

Sub Macro1()
'
' Macro1 Macro
'

'
    Columns("A:A").Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R1048576C1", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Sheet1!R1C4", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion14
    Sheets("Sheet1").Select
    Cells(1, 4).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Name"), "Count of Name", xlCount
End Sub

标签: excel vba
2条回答
\"骚年 ilove
2楼-- · 2019-09-06 19:28

WHY CANT U TRY LIKE THIS INSTEAD OF VBA

=COUNTIF(A:A,C2)    'HERE C2 IS THE REFERENCE

enter image description here

查看更多
地球回转人心会变
3楼-- · 2019-09-06 19:40

Give this small macro a try:

Sub KountUneek()
    Dim c As Collection, wf As WorksheetFunction, _
        K As Long, N As Long, i As Long, _
        v As Variant
    Set c = New Collection
    Set wf = Application.WorksheetFunction
    K = 1
    N = Cells(Rows.Count, "A").End(xlUp).Row
    On Error Resume Next

    For i = 1 To N
        v = Cells(i, "A").Value
        c.Add v, CStr(v)
        If Err.Number = 0 Then
            Cells(K, "B").Value = v
            Cells(K, "C").Value = wf.CountIf(Range("A:A"), v)
            K = K + 1
        Else
            Err.Number = 0
        End If
    Next i
    On Error GoTo 0
End Sub

For example:

PseudoPivot

查看更多
登录 后发表回答