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

zorsite

蓝桥玄霜 发表于 2010-10-18 12:50
实例4  拆分数据不重复
一、问题的提出：
有一列各种手机品牌型号的数据，要求编写一段代码，按照品牌划分成没有重复数据的三大类。...

有新想法，先记录下来。

1.       Arrx = Array("MOTO", "三星", "诺基亚", "索爱")
   
2.       Arry = Array("金立", "步步高", "联想", "天语", "OPPO", "波导", "TCL", "酷派")
   
3.       arr1 = VBA.Filter(Arrx, Left("MOTO600", 2), 1) '筛选所有含A2的数值组成一个新数组
   
4.       arr2 = VBA.Filter(Arry, "波导500", 1)   

复制代码

zorsite

根据之前的思路，查找了一些资料，完善了代码。
蓝桥玄霜版主用了两层For循环，还用了goto，作为初学者看起来有些吃力。
于是我就在想，不就是判断品牌吗，拿出一个型号来，看看它型号前两个字符能不能在各品牌序列中找到。如果能找到，就把它归为一类。
而且蓝桥玄霜版主把程序主框架都搭起来了，我就在他的基础上改了一下。主要就是把两个For循环改为一个For循环，其他的没有变动。

1. 
   
2. Sub 手机品牌分类()
   
3. Dim Myr&, Arr, x&
   
4. Dim d, d1, d2
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. Set d1 = CreateObject("Scripting.Dictionary")
   
7. Set d2 = CreateObject("Scripting.Dictionary")
   
8. Myr = [a65536].End(xlUp).Row
   
9. Arr = Range("a2:a" & Myr)
   
10. Range("c2:e" & Myr).ClearContents
    
11. my = Array("MOTO", "诺基亚", "三星", "索爱")
    
12. gc = Array("OPPO", "联想", "天语", "金立", "步步高", "波导", "TCL", "酷派")
    
13. '----------------------------------------------------------------------------
    
14.     For x = 1 To UBound(Arr)
    
15.         arr1 = Filter(my, Left(ActiveSheet.Cells(x + 1, 1), 2), 1)
    
16.         arr2 = Filter(gc, Left(ActiveSheet.Cells(x + 1, 1), 2), 1)
    
17.             If UBound(arr1) = 0 Then
    
18.                 d(Arr(x, 1)) = ""
    
19.             ElseIf UBound(arr2) = 0 Then
    
20.                 d1(Arr(x, 1)) = ""
    
21.             Else
    
22.                 d2(Arr(x, 1)) = ""
    
23.             End If
    
24.     Next
    
25. '-------------------------------------------------------------------------------
    
26.     Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys)
    
27.     Range("d2").Resize(UBound(d1.keys) + 1, 1) = Application.Transpose(d1.keys)
    
28.     Range("e2").Resize(UBound(d2.keys) + 1, 1) = Application.Transpose(d2.keys)
    
29. End Sub

复制代码

空数组的概念：空数组首先它必须是数组，其次它没有元素。
VBA用UBound(arr)=-1来表示空数组。
如果返回的数组的上标为0，也即UBound(arr)=0的时候，说明它有1个元素存在；如果返回的数组的上标为3，也即UBound(arr)=3的时候，说明它有4个元素存在。


数组默认下标下界是0，所以空数组有一个特性就是下界大于上界。

例：
Sub Ehp_arr()
Dim i!
Dim arr, arr2, arr3
arr = Array("face", "计费", "Sheet1")
arr2 = Array("单价", "计费", "表")
For i = 0 To UBound(arr2)
    arr3 = Filter(arr, arr2(i))
    'Filter函数返回空数组
    If LBound(arr3) > UBound(arr3) Then
    '通过比较arr的上下界来判断数组是否为空
        MsgBox "数组arr3是一个空数组"
    Else
        MsgBox "数组arr3不是一个空数组"
    End If
Next
End Sub

zorsite

蓝桥玄霜 发表于 2010-10-18 12:50
实例4  拆分数据不重复
一、问题的提出：
有一列各种手机品牌型号的数据，要求编写一段代码，按照品牌划分成没有重复数据的三大类。 ...

研究了山菊花版主的解决方案，赞叹啊。

最开始我也想到了要利用like函数来对比，只是我的思维不够清晰，对比双方的顺序反了。
我是拿(手机型号前两位 like  "*MOTO*诺基亚*三星*索爱*")来进行判断，比如：
("MO" like  "*MOTO*诺基亚*三星*索爱*")
这样对比当然导致了所有的结果都是false。
正确的做法应该像山菊花版主这样：
( "MOTO诺基亚三星索爱" like "*MO*")
这样就能得到正确的分类结果。


山菊花版主的另一妙处在于对字典和数组的精妙运用，真是叹为观止啊。

咋看上去，似乎山菊花版主的代码中字典的存在没有意义。可是把字典相关的代码删除后运行就会发现，能对所有的手机型号进行品牌分类，但是不能去掉重复的型号。

那字典又是如何去重呢？关键就是在外层的if判断。

    For i = 2 To nRow
        If Not ds.Exists(Arr(i, 1)) Then
            ds(Arr(i, 1)) = ""
                           .........此处为品牌分类if判断
        End If
    Next
也就是说，当某行的手机型号已经存在于字典，则直接跳至endif，不再进行品牌分类判断。
如果手机型号不存在于子典，则执行下列代码：
            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
这段代码的开头用的是if而非elseif，这一点非常重要。如果承接外层if语句而使用了elseif，则外层去除重复型号的if语句就失效了。

还有一点就是对于
    Dim  s(1 To 3) As Integer

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

                s(3) = s(3) + 1
                Brr(s(3), 3) = Arr(i, 1)
有点不太理解。这里为什么要定义 s(1 To 3) 呢？按照蓝桥玄霜版主的解释：
s(1) = s(1) + 1 ：数组s的第一个元素+1以后赋给数组s的第一个元素。
这里的s(1),s(2),s(3)都是数组。
其实我觉得这里没有必要用数组啊，即便定义x,y,z as integer，然后用x,y,z取代s(1),s(2),s(3)，效果应该是一样的吧。

zorsite

蓝桥玄霜 发表于 2010-10-18 12:52
[/code]实例5  前期绑定的字典实例
一、问题的提出：
有多列多行数据，其中有重复的行，要求编写一段代码 ...

看到例5的时候，开始对字典产生了一点小疑惑。
因为去重这个功能，在excel的新版本中非常容易使用，没有必要写大段代码来实现excel自带的功能。
而且在这一案例中，如果有两个李先生有不同的电话，三个张先生有不同的电话，这段代码是不适用的。
而excel自带的“删除重复项”功能可以实现只删除所有记录完全一致的行。

回头想想前面的几个例子，是否可以不用字典，就用excel的函数或命令来达成目的呢？
似乎例2和例4比较复杂一些，但也不是说只有编程才能完全实现。
比如例4，可以使用find函数进行字符串对比，从而确定品牌的分类。分类确定之后就是引用问题了，可以先排序，复制粘贴，也可以使用函数实现。至于去重，用excel自带命令就好。

目前学习字典，完全是兴趣使然，成功写出一段代码，是很有满足感的。只是时间成本稍微高了点。

reverie2008

优秀作品，谢谢分享。

mmwwdd

版主的字典用法已经到了出神入化的程度

szf_790403

谢谢蓝桥版主，造福我等菜鸟啊。

zhouxiao

非常感谢楼主

F8518

感谢分享！

microyip

好知识点，学习了！