说说词典和数组

wzsy2_mrf

一、背景略说：
论坛上还有很多人对词典有些稀里糊涂，甚至有些恐惧。其实词典是个很简单的东西，它比你常用的range,cells,worksheets,fso等简单多了。简单地测一下，比如你定义dim rng as range，然后再写rng.你看看会弹出多少东西，再定义一下Dim d As New Dictionary,再看看d.会弹出多少项目。可见，后者会前者少多了。这从一方面说明后者比前者的简单性。
程序设计并不难，因为程序是现实在计算计领域的映射，所以设计程序的时候经常首先思考的是你对某项工作平时是怎么做的，然后把它转化成计算计的动作，而其媒介则是程序设计语言。

在计算计领域，一切均由数构成，所谓“万物皆是数”，但这些数的类型是分层次的，一些类型是原子类型，而另一些则是复合类型。原子类型的数是基本构件，复合类型的数则是在原子类型基础上和重构。
在VBA中，整数、长整、浮点、双精度、字符等类型是原子类型，而带有属性、方法的类型则是复合类型，复合类型也分二种，一种不带方法（指操纵内部属性数据的方法，实际是该类型数提供给编程者的程序接口），这种类型是一种结构体，在VBA中由
type
.......
end type
定义的就是，另一种是带有方法的复合类型，这种类型就是对象。词典就是VBA中难以计数的对象之一。
二、词典的属性与方法：
词典的属性有以下几个：
key,keys,item,items,count,CompareMode
key---------关键词
keys-------由key所组成的关键词数组（原本是所谓方法之一，但当成属性更易解释）
item-------项目
items------由项目所组成的项目数组（同keys)
count------关键词总数
CompareMode--------比较模式

词典的方法有以下几个：
add---------将某key加入词典中
语法 d.add key1 item1（这里的key1,item1指的是具体的关键字和项目）
快捷写法d(key1)=item1
Exists-------用来检测某关键字是否在词典中
语法：if d.exists(key1) then
      或者if not d.exists(key1) then
remove----------用来清除词典中的某关键词
语法：d.rwmove key1
removeAll----------用来清除词典中的全部关键词
语法：d.rwmoveAll

注意 remove和removeall方法尽量少用，词典反复重建的话会对效率影响较大，实际上与其用remove方法不如在其key对应的Item上打上标志以便于后续处理。

wzsy2_mrf

三、词典的原理和基本作用
词典的原理是通过key值去计算所对应的项目在词典中的位置，它不是采取通常的一个个对比得到位置，而是直接采取某种公式计算得到。举一个例，比如有关键字3,5,9,6等，那么我定义一个数组dic(1 to 10)，让key所对应的item直接放在dic(key)位置，这样不用比较，一步到位，速度当然会非常之快。当然事实上不会那么简单，会有容量的问题，地址冲突的问题，但这些问题不需我们考虑，我们只要利用它的接口（方法）使用就可以了。

关于词典的作用。很多人一看到词典就会想到去重，其实词典的最基本作用是检索。你平时生活用词典的作用大概就是查某一词所对应的解释等。词典对象的主要作用也是这个，去重不过是在建立词典过程顺带利用。

wzsy2_mrf

四、数组
我们用词典的目的是什么啊？不就为了提高程序执行效率吗？但在VBA中，光靠词典无疑是不能达到目的，词典只在查找方面有优势，但如我们在程序中和一个个单元格（cell）打交道，那么，当数据量较大的时候非慢得象蜗牛那样不可。道理很简单，因为每个cell都是对象，对象本身有一大堆属性、方法，象cell中有value,value2,text,width,color......,这其中大多数是我们在程序中用不着的，或者至少是在最后输出之前用不着的，我们所用的大多数不过是其中的value而已，但我们既用了cell中value，于是不得将他的那些无用兄弟们一并带上，这就是程序执行慢的根本原因之一。有没有办法把那些负担甩掉呢？有，这就是用数组。
数组具体如何定义，利用这里就不多说了，读者可以自行去搜索数组的帖子，这里就要讲讲数组如何应用。
1、数组从range取值
with sheet1
arr=.range("A2:E" & .cells(.cells.rows.count,1).end(xlup).row))
end with
可以通过上述代码将范围A2:E(省略） 的单元格value赋给arr

注意由此所得到均是二维数组，无论一行还是一列都是，即即使将上面的“E”改成“A”，或者将"A2:E"改成“A2:E2"还是。其起始号是1。

解释：
.cells.rows.count   'sheet1表的行总数
.cells(.cells.rows.count,1)   'A列的最后一个单元格
.cells(.cells.rows.count,1).end(xlup).row '从A列最后一个单元格向上查找到第一个有数单元格的行号

2、range从数组取数。
我们程序运行的目的总是在特定单元格显示我们所需要的值，这就需要range从数组中取数。
其语句一般为：
with sheet1
.range("A2") .resize(ubound(arr),ubound(arr,2))=arr
end with
解释：
range("A2") '代码中的a2单元格,也可用cells(2,1)来表示.
resize,区域变化的方法。
.range("A2") .resize(ubound(arr),ubound(arr,2)) 就是以将a2单元格扩展。行方向扩展ubound(arr) 大小，也就是arr数组行数，列方向可作同样理解的。
注意：可以用.range("A2") .resize(r,c) 也行，只要r<=ubound(arr),c<=ubound(arr,2)即可，注意不要超过，否则将会出现#N/A错误，这就需要做好边界控制。

下面将举实例说明。请注意实例有的会有一定难度，太简单了自己去搜索一下就行了。

wzsy2_mrf

实例1，简单分类求和

1. 
   
2. Sub flqh()
   
3.     Dim i&, j&, dic, arr, myR%
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     myR = Range("C6").End(xlDown).Row '取得最大行号
   
6.     arr = Range("C6:N" & myR) 'arr,brr数据源
   
7.     brr = Range("o6:o" & myR)
   
8.     For i = 1 To UBound(arr, 2) - 1
   
9.         For j = 1 To UBound(arr, 1)
   
10.             If arr(j, i) <> "" Then
    
11.                 If Not dic.exists(arr(j, i)) Then
    
12.                     dic(arr(j, i)) = brr(j, 1)
    
13.                 Else
    
14.                     dic(arr(j, i)) = dic(arr(j, i)) + brr(j, 1) '汇总
    
15.                 End If
    
16.             End If
    
17.         Next
    
18.     Next
    
19.     arr = Array(dic.keys, dic.items) '重新将arr 排为目标数组
    
20.     Range("p6").Resize(1000, 2).ClearContents '将输出显示区域清空
    
21.     Range("p6").Resize(dic.Count, 2) = Application.Transpose(arr) '将arr输出到显示区域
    
22. End Sub
    

复制代码

wzsy2_mrf

实例二，这个例子较为复杂了
一词典多列、多表去重输出
Sub 遍历多表固定列不重复wzsy2_mrf()
    Dim sht As Worksheet, sh As Worksheet, arr, j&, k&, rend&, mkey
    Set sh = Sheets("汇总")
    ReDim brr(1 To 70000, 1 To Sheets.Count + 1)  '定义目标数组brr
    sh.Range("A1").CurrentRegion.ClearContents  '清除内容
    Set d = CreateObject("scripting.dictionary")
    For Each sht In Worksheets                '遍历所有工作表
        With sht
            rend = .Cells(.Rows.Count, 1).End(3).Row
            If .Name <> sh.Name And rend > 1 Then  '不等于汇总工作表及不是空表时！
                k = k + 1
                arr = .Range("A2:A" & rend)
                brr(1, k) = "只在" & .Name & "中出现"
                For j = 1 To UBound(arr)
                    If arr(j, 1) <> "" Then
                        If Not d.exists(arr(j, 1) & "") Then
                            d(arr(j, 1) & "") = k & "~~" '将关键字arr(j,1) 对应的项目标志对应经历有表的索引，加上"~"符是必要的，目的是将使"1"与"13"不存在包含关系。
                        Else
                            If InStr(d(arr(j, 1) & ""), k & "~~") = 0 Then d(arr(j, 1) & "") = d(arr(j, 1) & "") & "|" & k & "~~" '将经历过的表的索引都记录下来
                        End If
                    End If
                Next
            End If
        End With
    Next
    ReDim arr(1 To k + 2)    '总共经历了k张表，因为每张表的单独出现的关键字个数不一样，所以将arr重新定义为brr每列长度的控制数组，这时原arr数组已经没有用了
    For j = 1 To k + 2
        arr(j) = 2    '从第二行开始
    Next
    brr(1, k + 1) = "各表都有" '总共经历k张表，目标数组有k+2列
    brr(1, k + 2) = "全部"
    For Each mkey In d.keys
        If UBound(Split(d(mkey), "|")) = 0 Then    '当只有一组数的时候
            j = Val(Left(d(mkey), Len(d(mkey)) - 2))
            brr(arr(j), j) = mkey
            arr(j) = arr(j) + 1
        ElseIf UBound(Split(d(mkey), "|")) = k - 1 Then    '全部经历的时候
            brr(arr(k + 1), k + 1) = mkey
            arr(k + 1) = arr(k + 1) + 1
        End If
        brr(arr(k + 2), k + 2) = mkey    '全部数
        arr(k + 2) = arr(k + 2) + 1
    Next
    sh.Range("A1").Resize(d.Count + 1, UBound(brr, 2)) = brr
End Sub

wzsy2_mrf

要提高词典的运用水平，关键要在key 和它所对应的 Item上做文章，不要动辄d(key)=""，这样除了去重以外起不到任何效果。下面的例子就是通过词典来固定输出列，从而起到简化程序作用。

1. Sub 行转列()
   
2.     Dim arr, brr, i&, k&, x&, kk, d, k1%, str$
   
3.     With Sheet1
   
4.     arr = .Range("A1:A" & .Cells(.Rows.Count, 1).End(3).Row)
   
5.     ReDim brr(1 To UBound(arr), 1 To 10) '目标数组，最后输出用
   
6.     Set d = CreateObject("Scripting.Dictionary")
   
7.    
   
8.     x = 1: k = 1 '
   
9.     For i = 1 To UBound(arr)
   
10.         If IsError(arr(i, 1)) Then GoTo a0: '如果arr(i,1)是错误字符的话，略过
    
11.         If Left(arr(i, 1), 4) = "    " Then '根据字符特征来提取数据，因为要提取的数据都是"     "开头，中间有"="的那种。
    
12.             x = x + 1 'x代表目标数组的行号
    
13.             Do While InStr(arr(i, 1), "=") > 0
    
14.                 kk = Split(arr(i, 1), "=") '将arr(i,1)以"="分裂成数组kk
    
15.                 str = Trim(kk(0)) '列标题
    
16.                 If Not d.exists(str) Then
    
17.                     d(str) = k '通过词典将该标题数据固定在k列上，这样以后同一标题的数据均将出现在同一列上
    
18.                     If k > UBound(brr, 2) Then ReDim Preserve brr(1 To UBound(brr), 1 To k) '根据k值大小动态扩展brr的列数，这是适应程序需要并节省内存的一种方法
    
19.                     k = k + 1
    
20.                 End If
    
21.                 k1 = d(str)
    
22.                 If brr(1, k1) = "" Then brr(1, k1) = str '将标题放在brr数组的第d(str)列第一行上
    
23.                 brr(x, k1) = Trim(kk(1)) '在第x行的对应列放入内容
    
24.                 i = i + 1
    
25.                 If i > UBound(arr) Then Exit Do
    
26.             Loop
    
27.         End If
    
28. a0:
    
29.     Next
    
30.     .Range("E26").Resize(10000, k - 1).Clear
    
31.     .Range("E26").Resize(x, k - 1) = brr '目标数组实际使用x行，k-1列。
    
32. End With
    
33. End Sub
    
34. 
    

复制代码

词典 行列分拆转换.zip (18.14 KB, 下载次数: 217)

2014-9-6 09:36 上传

点击文件名下载附件

ljx63426

通俗易懂，谢谢楼主，学习了，

ak47ok

每次回帖、谢谢！辛苦了。

mmwwdd

这个不错，喜欢字典

2007小金猪

的确，这个总结精辟