可以求出Excel中重復(fù)姓名及重復(fù)的次數(shù)的VBA代碼

假如，表格中的人物的姓名，有很多是重復(fù)的，而問題的需求是：要求編寫一段代碼，把重復(fù)的人的姓名以及重復(fù)的次數(shù)求出來，復(fù)制到另一個表格中。

我們可通過如下的VBA代碼來實現(xiàn)。

Sub CountCFZ()

Dim i&, Myr&, Arr

Dim d, k, t

Set d = CreateObject("Scripting.Dictionary")

Myr = Sheet1.[a65536].End(xlUp).Row

Arr = Sheet1.Range("a1:g" & Myr)

For i = 2 To UBound(Arr)

d(Arr(i, 3)) = d(Arr(i, 3)) + 1

Next

k = d.keys

t = d.items

Sheet2.Activate

[a2].Resize(d.Count, 1) = Application.Transpose(k)

[b2].Resize(d.Count, 1) = Application.Transpose(t)

[a1].Resize(1, 2) = Array("重復(fù)的姓名", "重復(fù)的次數(shù)")

Set d = Nothing

End Sub

部分代碼的解釋如下：

1、Dim i&, Myr&, Arr ：變量i和Myr聲明為長整型變量。 也可以寫為 Dim Myr As Long 。Long 的類型聲明字符為(&)。Arr后面沒有寫明數(shù)據(jù)類型，默認就是可變型數(shù)據(jù)類型(Variant)。

2、Set d = CreateObject("Scripting.Dictionary")：創(chuàng)建字典對象，并把字典對象賦給變量d。這是最常用的一句代碼。所謂的“后期綁定”。用了這句代碼就不用先引用c:\windows\system32\scrrun.dll了。

3、Myr = Sheet1.[a65536].End(xlUp).Row ：把表1的A列最后一行不為空白的行數(shù)賦給變量Myr。這里用了Range對象的End屬性，它有4個方向參數(shù)，此處的xlUp表示向上，它的值為3，所以也可寫成End(3)。xlDown表示向下，它的值為4;xlToLeft表示向左，它的值為1;xlToRight表示向右，它的值為2。

4、Arr = Sheet1.Range("a1:g" & Myr)：把表1的A1到G列最后一行不為空白的 單元格區(qū)域的值賦給變量Arr。這樣Arr就是個二維數(shù)組了，用數(shù)組替代單元格引用可對執(zhí)行代碼的速度提高很多很多。

5、For i = 2 To UBound(Arr) ：For…Next循環(huán)結(jié)構(gòu)，從2開始到數(shù)組的最大上界值之間循環(huán)。因為數(shù)組的第一行是表頭。Ubound是VBA函數(shù)，返回數(shù)組的指定維數(shù)的最大可用上界。

6、d(Arr(i, 3)) = d(Arr(i, 3)) + 1 ：Arr(i,3)在本例是姓名列，也就是關(guān)鍵字列，舉個例子，假如Arr(i,3)=”青山”，這句代碼的意思就是把關(guān)鍵字”青山”加入字典，d(key)等于關(guān)鍵字key對應(yīng)的項，每出現(xiàn)一次這個關(guān)鍵字，它的項的值就增加1。起到了按關(guān)鍵字累加的作用，也正因為有這個作用，所以可使用字典來進行各種匯總統(tǒng)計。后面要講的實例會充分的展現(xiàn)這個作用。

7、k=d.keys ：把字典d中存在的所有的關(guān)鍵字賦給變量k。得到的是一個一維數(shù)組，下限為0，上限為d.Count-1。Keys是字典的方法，前面已經(jīng)講過了。

8、t=d.items ：把字典d中存在的所有的關(guān)鍵字對應(yīng)的項賦給變量t。得到的也是一個一維數(shù)組，下限為0，上限為d.Count-1。Items也是字典的方法，前面也已經(jīng)講過了。

9、Sheet2.Activate ：激活表2。

10、[a2].Resize(d.Count, 1) = Application.Transpose(k) ：把字典d中所有的關(guān)鍵字賦給以a2單元格開始的單元格區(qū)域中。詳細的解釋請見前面的keys方法一節(jié)。

11、[b2].Resize(d.Count, 1) = Application.Transpose(t) ：把字典d中所有的關(guān)鍵字對應(yīng)的項賦給以b2單元格開始的單元格區(qū)域中。

12、[a1].Resize(1, 2) = Array("姓名", "重復(fù)個數(shù)") ：Array是一個VBA函數(shù)，返回一個下界為0的一維數(shù)組。一維數(shù)組是水平排列的，所以賦值給水平的單元格區(qū)域不需要用轉(zhuǎn)置函數(shù)了。這里作為表頭一次性輸入。

13、Set d = Nothing ：釋放字典內(nèi)存。