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

时间:2015-06-08 20:57:11

标签: excel vba excel-vba

我想要实现的是一个VBA代码,用于复制和计算列中的所有单词并将其移动到按高频率排序的另一个表单中。行数可以不同。见下文:

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

新表:

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

知道怎么做吗? 非常感谢。

2 个答案:

答案 0 :(得分:1)

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

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

这将让您知道如何创建枢轴并做必要的事情。

谢谢,

答案 1 :(得分:0)

这样可行,只需在运行此列之后对列B上的“列表”工作表进行排序:

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