EXCEL VBA 高阶 字典用法集锦及代码详解之 拆分数据不重复2

一、问题的提出：

有一列各种手机品牌型号的数据，要求编写一段代码，按照品牌划分成没有重复数据的三大类。

二、代码：

Sub 拆分()

Dim pp1$, pp2$, nRow%, ds, Brr(), s(1 To 3) As Integer

Set ds = CreateObject("scripting.dictionary")

pp1 = Join(WorksheetFunction.Transpose(Range(Range("g2"), Range("g1").End(xlDown))), ",")

pp2 = Join(WorksheetFunction.Transpose(Range(Range("h2"), Range("h1").End(xlDown))), ",")

nRow = Range("a1").End(xlDown).Row

Arr = Range("a1:a" & nRow)

ReDim Brr(1 To nRow, 1 To 3)

For i = 2 To nRow

If Not ds.Exists(Arr(i, 1)) Then

ds(Arr(i, 1)) = ""

If pp1 Like "*" & Left(Arr(i, 1), 2) & "*" Then

s(1) = s(1) + 1

Brr(s(1), 1) = Arr(i, 1)

ElseIf pp2 Like "*" & Left(Arr(i, 1), 2) & "*" Then

s(2) = s(2) + 1

Brr(s(2), 2) = Arr(i, 1)

Else

s(3) = s(3) + 1

Brr(s(3), 3) = Arr(i, 1)

End If

End If

Next

Range("c2:e" & nRow) = Brr

End Sub

三、代码详解

1、pp1 = Join(WorksheetFunction.Transpose(Range(Range("g2"), _

Range("g1").End(xlDown))), ",") ：

这句代码用了两个VBA函数Join 和Transpose ，Range("g1").End(xlDown)从G1单元格往下直到最下面的单元格，遇到空白格就停止。因为本例的G14、G15单元格有 另外的数据存在，如果还是用Range("g65536").End(xlUp)，那么就会把不需要的数据带进去，造成结果出错。Transpose 转置函数，前面已经介绍过了。Join函数是通过连接某个数组中的多个子字符串而创建的一个字符串，本句代码执行后得到pp1="MOTO, 诺基亚, 三星, 索爱"。

pp2一句同上句一样，得到另一个字符串。

2、nRow = Range("a1").End(xlDown).Row ：把A列最后一行不为空白的行数赋给整型变量nRow。

3、Arr = Range("a1:a" & nRow) ：把A列A1开始的有数据的单元格区域赋给变量Arr。

4、ReDim Brr(1 To nRow, 1 To 3) ：用于为动态数组变量Brr重新分配存储空间。第一维的下界从1到上界nRow，第二维从1到3。

5、For i = 2 To nRow ：从2到 nRow逐一循环。

6、If Not ds.Exists(Arr(i, 1)) Then ：如果字典ds中不存在关键字Arr(i, 1)

7、ds(Arr(i, 1)) = "" ：把Arr(i, 1)作为关键字加入字典ds。

8、If pp1 Like "*" & Left(Arr(i, 1), 2) & "*" Then ：这里山版主用了比较运算符Like来比较pp1和取自Arr(i, 1)左边两个字符，再在前后加任意字符组成的字符串，如果满足条件为真，那么执行下面的语句。

9、s(1) = s(1) + 1 ：数组s的第一个元素+1以后赋给数组s的第一个元素。

10、Brr(s(1), 1) = Arr(i, 1) ：把这个关键字赋给第2维为1的另一个数组Brr，也就是我们要求的贸易机类。pp1字符串里都是贸易机类的品牌。

11、ElseIf pp2 Like "*" & Left(Arr(i, 1), 2) & "*" Then ：同样，如果满足国产品牌类这个条件，那么执行下面的代码。

12、s(2) = s(2) + 1 ：数组s的第二个元素+1以后赋给数组s的第二个元素。

13、Brr(s(2), 2) = Arr(i, 1) ：把这个关键字赋给第2维为2的另一个数组Brr，也就是我们要求的国产品牌类。pp2字符串里都是国产品牌类的品牌。

14、s(3) = s(3) + 1 ：前如果条件都不满足时，数组s的第三个元素+1以后赋给数组s的第三个元素。

15、Brr(s(3), 3) = Arr(i, 1) ：把这个关键字赋给第3维为1的另一个数组Brr，也就是我们要求的其它品牌类。

16、Range("c2:e" & nRow) = Brr ：把数组Brr赋给[c2]单元格开始的区域中。