一、問題的提出：

有一列各種手機品牌型號的數據，要求編寫一段代碼，按照品牌劃分成沒有重複數據的三大類。

二、代碼：

Sub caifen()

Dim Myr&, Arr, x&

Dim d, d1, d2, i&, j&

Set d = CreateObject("Scripting.Dictionary")

Set d1 = CreateObject("Scripting.Dictionary")

Set d2 = CreateObject("Scripting.Dictionary")

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

Arr = Range("a2:a" & Myr)

Range("c2:e" & Myr).ClearContents

my = Array("MOTO", "諾基亞", "三星", "索愛")

gc = Array("OPPO", "聯想", "天語", "金立", "步步高", "波導", "TCL", "酷派")

For x = 1 To UBound(Arr)

For i = 0 To UBound(my)

If InStr(Arr(x, 1), my(i)) > 0 Then

d(Arr(x, 1)) = ""

GoTo 100

End If

Next i

For j = 0 To UBound(gc)

If InStr(Arr(x, 1), gc(j)) > 0 Then

d1(Arr(x, 1)) = ""

GoTo 100

End If

Next j

d2(Arr(x, 1)) = ""

100:

Next x

Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys)

Range("d2").Resize(UBound(d1.keys) + 1, 1) = Application.Transpose(d1.keys)

Range("e2").Resize(UBound(d2.keys) + 1, 1) = Application.Transpose(d2.keys)

End Sub

三、代碼詳解

1、Set d2 = CreateObject("Scripting.Dictionary") ：針對三個不同的種類，創建d、d1、d2三個字典對象。

2、Myr = [a65536].End(xlUp).Row ：把A列最後一行不為空白的行數賦給變數Myr。

3、Arr = Range("a2:a" & Myr) ：把A2開始的有數據的單元格區域賦給變數Arr。

4、Range("c2:e" & Myr).ClearContents ：把C2到E列單元格區域清空。

5、my = Array("MOTO", "諾基亞", "三星", "索愛") ：VBA函數Array返回一個一維數組，默認下界為0。把Array函數返回的數組賦給變數my(貿易兩漢字的首字母)。

6、gc = Array("OPPO", "聯想", "天語", "金立", "步步高", "波導", "TCL", "酷派") ：把Array函數返回的數組賦給變數gc(國產兩漢字的首字母)。

7、For x = 1 To UBound(Arr) ：在A列原始數據的數組中逐一循環。

8、For i = 0 To UBound(my) ：在my數組中逐一循環。因為有4個貿易機品牌，所以用循環每一個與原始數據比較。

9、If InStr(Arr(x, 1), my(i)) > 0 Then ：VBA函數Instr返回在第1個參數中查找的位置，如果返回結果＝0，表示在第1個參數中沒有第2個參數存在。本句的意思是如果找到貿易機品牌的話，執行下面的代碼。

10、d1(Arr(x, 1)) = "" ：接上句，如果上面判斷成立，就把Arr(x, 1)加入字典d。

11、GoTo 100 ：Goto語句用於無條件地轉移到過程中指定的行。這裡採用跳出For i循環，一是為了減少循環的次數，比如"MOTO"找到的話，後面3個就不需要找了；二是為了跳過兩個小循環之後的其它品牌加入第3個字典的d2(Arr(x, 1)) = ""語句。

12、For j循環與上面相同，為了判斷得到國產機類的字典d1。

13、d2(Arr(x, 1)) = "" ：如果上述兩個小循環都不滿足，那麼就加入其它品牌類字典里。

14、Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys) ：最後的3句分別把字典的關鍵字數組轉置後賦給相應的單元格區域。

代碼執行後如圖實例4-1所示。

喜歡這篇文章嗎？立刻分享出去讓更多人知道吧！