VBA复制并计算特定列的单词并将其移到另一个表单中

我试图达到的是一个VBA代码来复制和计算列中的所有单词，并将其移动到另一个按高频率sorting的表单中。 行数可以不同。 见下文：

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

我认为testing方法是创build数据透视表并添加行列表和列数。

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

这将让你知道如何创build枢纽和做需要。

谢谢，

Answer 2

这将工作，只需要在运行此列后对列B上的“列表”工作表进行sorting：

 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