VBA字典用法集锦及代码详解(5)

实例4 拆分数据不重复

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(\& nRow) = Brr End Sub

五、代码详解

1、pp1 = Join(WorksheetFunction.Transpose(Range(Range(\ Range(\ ：

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

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

2、nRow = Range(\ ：把A列最后一行不为空白的行数赋给

整型变量nRow。

3、Arr = Range(\& 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 \ ：这里山版主用了比较运算符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，也就

21

常见字典用法集锦及代码详解

是我们要求的贸易机类。pp1字符串里都是贸易机类的品牌。

11、ElseIf pp2 Like \ ：同样，如果满足国产品牌类这个条件，那么执行下面的代码。

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(\ ：把数组Brr赋给[c2]单元格开始的区域中。

实例5 前期绑定的字典实例

一、问题的提出：

有多列多行数据，其中有重复的行，要求编写一段代码，求得不重复的行数据。 如图实例5-1所示。

22

图 实例5-1 示例

实例5 前期绑定的字典实例

二、代码：

Sub 保留原数据() ?by:ldy888

?前期绑定，需先引用c:\\windows\\system32\\scrrun.dll Dim d As New Dictionary,t For i = 2 To 5

Set d(Cells(i, 1) & \= Range(Cells(i, 1), Cells(i, 4))

Next t=d.items End Sub

三、代码详解

1、Dim d As New Dictionary, t ：本段代码需要先引用微软的脚本运行时库Microsoft Scripting Runtime，可在VBE窗口，从菜单－工具－引用，然后勾选Microsoft Scripting Runtime，或者点击浏览，在添加引用对话框中选择c:\\windows\\system32\\scrrun.dll，并打开，确定。完成引用。在本声明语句中把字典d声明为New Dictionary。这就是”前期绑定”了。上面的实例用的是创建对象语句：

Set d = CreateObject(\，称为”后期绑定”。不需要先引用脚本运行时库。

2、Set d(Cells(i, 1) & \：把单元格对象加入字典，它对应的项是同一行的单元格区域。注意，这里用了Set，和前面的几例不一样哦。如果用Typename(d(Cells(i, 1) & \，得到的是一个Range对象。这里的Cells(i, 1) & \也可以用Cells(i, 1).Value来代替。

3、t=d.items ：把字典d中存在的所有的关键字对应的项赋给变量t。得到的是一个一维数组，下限为0，上限为d.Count-1。

4、[A11].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(t)) ：这句用了两次工作表转置函数Transpose之后赋给A11单元格开始的区域中。

代码执行后如图实例5-2所示。

[A11].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(t))

23

常见字典用法集锦及代码详解

图 实例5-2示例

实例6 多条件复杂汇总

一、问题的提出：

有一个表格，需要对其中多个条件相同的数量进行合并汇总，并且要有汇总的明细数据，要求编写一段代码，实现这样的合并同类项的要求。

二、代码： Sub kf2() ?by:oobird

Dim d As Object, a, b, j%, w! Dim ss$, n%, x

Me.UsedRange.Offset(3, 0) = \

a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp)) Set d = CreateObject(\

24

实例6 多条件复杂汇总

ReDim b(1 To UBound(a), 1 To 8) For i = 1 To UBound(a)

ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8) If Not d.Exists(ss) Then

n = n + 1 d.Add ss, n

b(n, 1) = a(i, 2): b(n, 2) = a(i, 5): b(n, 3) = a(i, 6): b(n, 4) = a(i, 4) b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9) Else

b(d(ss), 7) = b(d(ss), 7) & \& a(i, 9) End If Next

For i = 1 To d.Count

x = Split(b(i, 7), \For j = 0 To UBound(x)

w = w + x(j) Next j

b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0 Next

[b4].Resize(n, 8) = b End Sub

三、代码详解

1、Dim d As Object, a, b, j%, w! ：Dim语句中的j% 等同于Dim j As Integer。w! 等同于Dim w As Single。类似的还有ss$ 等同于Dim ss As String。还有双精度数据类型Double的类型声明字符为#、货币数据类型Currency的类型声明字符为@。

2、Me.UsedRange.Offset(3, 0) = \：Offset是Range对象的属性，Offset(3, 0)的第

一个参数是行数；第二个参数是列数，意思是往下偏移3行，列不变。Me是活动工作表，相当于Activesheet; UsedRange为已经使用的单元格区域。本句可解释为：清空第3行以下的单元格。

3、a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp)) ：把原始数据所在的表1自A4以下的I列最后的非空单元格区域的值赋给变量a。

4、Set d = CreateObject(\：创建字典对象d。

5、ReDim b(1 To UBound(a), 1 To 8) ：根据数组a的大小重新声明数组b。 6、For i = 1 To UBound(a) ：在1 和数组a第一维的上界值之间逐一循环。

25

百度搜索“77cn”或“免费范文网”即可找到本站免费阅读全部范文。收藏本站方便下次阅读，免费范文网，提供经典小说综合文库VBA字典用法集锦及代码详解(5)在线全文阅读。