VBA复制和统计特定列的字数并将其移动到另一个工作表中

Question

我试图实现的是一个VBA代码来复制和计数的所有字在一列，并将其移动到另一张表排序的高频较低。行数可以不同。如下所示：

Column1:
Finance
SAP
Finance
HR
Design
Design
HR
People
SAP
SAP

新工作表：

SAP 3
Finance 2
Design 2
SAP 2
HR 2
People 1

你知道怎么做吗？非常感谢。

Answer 1

我认为测试方法将是创建数据透视表，并添加行标签和列计数。

http://www.thespreadsheetguru.com/blog/2014/9/27/vba-guide-excel-pivot-tables

这将让您了解如何创建pivot并执行必要的操作。

谢谢,

Answer 2

这将会起作用，只需在运行以下命令后对B列中的“List”工作表进行排序：

Sub Count_Sort()
Dim lastRow As Integer
Dim ws As String
Dim c As Range

ws = ActiveSheet.Name
lastRow = LastUsedRow
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$" & lastRow).RemoveDuplicates Columns:=1, Header:=xlNo
ActiveSheet.Name = "List"
Sheets(ws).Activate
Set c = Range("A1")
Set d = Sheets("List").Range("A1")
Do While Not IsEmpty(c)
    Do While Not IsEmpty(d)

        If c.Value = d.Value Then

            d.Offset(0, 1).Value = d.Offset(0, 1).Value + 1
            Set d = d.Offset(1, 0)
            Exit Do
        End If
        Set d = d.Offset(1, 0)
    Loop
    Set c = c.Offset(1, 0)
    Set d = Sheets("List").Range("A1")
Loop
End Sub


Public Function LastUsedRow()
LastUsedRow = [A65536].End(xlUp).Row
End Function