带您走进字典2

6个方法和4个属性

起床了,起床了,太阳晒屁股了,今天我们把6个方法和4个属性学习完
1.方法add 是添加的意思 
Sub test1() '给字典添加关键词和条目
'格式  字典对象+空格 +点号+add+空格+关键词+逗号+条目
  Dim dic
  Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
  With dic
     .Add "不及格", 0
     .Add "及格", 60
     .Add "良好", 70
     .Add "优秀", 80
   End With
End Sub
备注:'把上面的代码复制到模块里,大家一定要学会在本地窗口查看,这个是学习VBA的秘密,相当于学习数组函数要会按F9一样查看运算的结果,记住,千万要记住,一般人我不告诉的,呵呵,开了一下玩笑,把光标点到代码任何一行,视图
'菜单,本地窗口,F8逐步运行,大家可以看到关键词在不断增加,这里我没有用循环语句,当然在我们真正把数据装入关键词和条目会用到循环语句 ,有的朋友可能会说,我还没有理解这种装法,其实大家可以把字典看作多行二列的二维数组一样,一列是关键词,一列是条目,有时我们条目不装,为空,可以写成下面这样的
Sub Test2()'条目为空
Dim dic
  Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
  With dic
     .Add "不及格", ""
     .Add "及格", ""
     .Add "良好", ""
     .Add "优秀", ""
   End With
End Sub
现在我们来提一个问:如果要装入字典关键词重复会出现一个什么现象呢? 如
Sub Test2()'关键词重复会报错
Dim dic
  Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
  With dic
     .Add "不及格", ""
    .Add "不及格", ""
  End With
End Sub
我们运行上面的代码发现,重复装入关键字会报错,那怎么办呢,难道放在一边,让它凉拌,当然不是呢,在写程序时,有的错误是避免不了的,那我们就要想起这一句On Error Resume Next
Sub Test3() '解决了关键词重复会报错
    Dim dic
    On Error Resume Next
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    With dic
    .Add "不及格", ""
    .Add "不及格", ""
    End With
    On Error GoTo 0 '如果后面的代码有错,让它继续报错
End Sub
这里啰嗦一个On Error Resume Next这一句,好用少用,为什么呢,如果你不在用完它后添加一句On Error GoTo 0,后面有错误它也把错误忽略掉了,这样就不便于大家找错,也就是错了也不会提醒你,所以新手要注意这个,除了用这种方法装入字典关键词和条目还有一种方法 
格式 字典对象(关键字)=条目
Sub test4() '另一种方法添加关键词和条目
    Dim dic
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    dic("不及格") = 0
    dic("不及格") = 0
    dic("及格") = 60
End Sub
第二种方法添加我是这样理解的,也许我理解错了,dic("不及格") = 0,完整的语句应该是修改条目,由于修改条目的关键词不存在,会自动添加关键词,如果存在就会覆盖原来的,这样就会报错了,只是覆盖,完整的语句如下
dic.Item("不及格") = 0,省略了一个点号和一个item
有的朋友可能会问?
这两种有什么区别呢?
答案是肯定的,肯定有区别,区别大着呢,第一种方法是取得一个出现的,再出现重复的装不进去的,第二种方法是取得最后一次的出现的,前面出现会被覆盖.包括条目
因此利用它们的区别,我们可以应用到查找最后一次进货的和第一次出货的日期,当然前提条件我们的日期是排序的
吃饭了,吃饭了,吃饭时间到了，这一楼还没有完工,有空再继续……

=========================================================

我们接着上面继续
2.Count属性:前面我们讲过,它可以统计关键词的个数
Sub test5() '
    Dim dic
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    dic("不及格") = 0
    dic("不及格") = 0
    dic("及格") = 60
    MsgBox dic.Count
End Sub
大家运行代码,结果显示2,也就是说字典dic里的关键是2个,不是3个,上面我们讲过,因此字典有去重作用
3.Keys方法
4.Item方法
Keys的作用是把关键词从字典里读出来,一般我们把它赋一个数组,这个数组是一维的,且它的第一个编号是0,也就是它的上标是从0开始的
Items的作用是把条目从字典里读出来,一般我们把它赋一个数组,这个数组是一维的,且它的第一个编号是0,也就是它的上标是从0开始的
具体我们看一个实例
Sub test6() '验证Keys和Items方法
    Dim dic, arr1, arr2
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    dic("不及格") = 0
    dic("不及格") = 0
    dic("及格") = 60
    arr1 = dic.Keys '把字典里的所有关键词赋值给数组arr1
    arr2 = dic.Items '把字典里的所有条目赋值给数组arr2
   With Sheets("keys和Items")
        .[A1].Resize(dic.Count, 1) = Application.Transpose(arr1)
        .[B1].Resize(dic.Count, 1) = Application.Transpose(arr2)
        '上面的代码为什么要转,因为通过keys和Items方法读到数组都是一维的
        '如果读到单元格是横向的就不用转置,因为是纵向的,所以调用工作表内置数
        'Transpose函数转置一下
    End With
End Sub
接下来我们讲解2个自定义函数
一个是统计区域唯一值的个数
一个是去重函数
Function 计数(Rg As Range)
    Dim dic, arr1, ar
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    arr1 = Rg '把单元格区域装入到数组arr1里,因为装到数组里速度快一些
    For Each ar In arr1
        If ar <> "" Then ' 排除空单元格
            dic(ar) = "" ' 把数组arr1里的每一个元素依次装进字典dic里,进行去重
        End If
    Next ar
    计数 = dic.Count'把结果赋值给函数名'
End Function
Function 去重(Rg As Range, x As Integer)
    Dim dic, arr1, ar
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    arr1 = Rg '把单元格区域装入到数组arr1里,因为装到数组里速度快一些
    For Each ar In arr1
        If ar <> "" Then ' 排除空单元格
            dic(ar) = "" ' 把数组arr1里的每一个元素依次装进字典dic里,进行去重
        End If
    Next ar
    arr1 = dic.Keys
    If x <= dic.Count Then '如果函数的第二参数小于等于字典里的关键词个数,那么
        去重 = arr1(x - 1) '把数组arr1(x)这个元素赋值给函数去重
    Else '否则函数去重的值为空
        去重 = ""
    End If
End Function
' 备注,自定义去重这个函数,第一参数是单元格区域,且要加绝对引用,可以是多行多列,
'好过我们函数写的那个长长的去重公式,第二参数,如果大家是下拉就要用Row(A1),
'如=去重($A$1:$B$4,ROW(A1))
'如果右拉就用借助Column (A1)
5.方法Exists,判断关键词在字典里是否存在
Sub test7() 'Exists方法
    Dim dic
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    dic("不及格") = 0
    dic("不及格") = 0
    dic("及格") = 60
    If dic.Exists("不及格") Then '判断"不及格"关键词是否存在
        MsgBox "不及格--关键词存在"
    Else
      MsgBox "不及格--关键词不存在"
    End If
    If dic.Exists("优秀") Then '判断"不及格"关键词是否存在
        MsgBox "优秀--关键词存在"
    Else
      MsgBox "优秀--关键词不存在"
    End If
End Sub
6、Remove,清除字典里某一个关键词,且还清除其结构,而数组里的Erase,只能清除其值,不能清除数组空间结构
格式 dic.Remove "某一个关键词"
7'RemoveAll清除字典里所有关键词,且还清除其结构
格式 dic.RemoveAll
Sub test8() '方法Remove和RemoveAll
    Dim dic
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    dic("不及格") = 0
    dic("不及格") = 0
    dic("及格") = 60
    dic("良好") = 70
    dic("优秀") = 80
    MsgBox dic.Count '显示字典里有4个关键词
    dic.Remove "不及格"
    MsgBox dic.Count '显示字典里有3个关键词,因为关键词"不及格"被删除了
    dic.RemoveAll '显示字典里有0个关键词,因为关键词全部被删除了
    MsgBox dic.Count
End Sub
8、Key 属性,修改字典里的关键词
9、Item属性,修改字典里的某关键词的条目
Sub test9() '属性Key和Item
    Dim dic
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    dic("不及格") = 0
    dic.Key("不及格") = "D" '把关键词"不及格"修改为"D"
    dic.Item("D") = 59 '把关键词"D"的条目修改为59
End Sub
备注:至于在本地窗口的变化,自己去查看,我不再多说了
10.'CompareMode '属性 比较模式 如 Dic.CompareMode=1不区分大小写，Dic.CompareMode=0区分大小写
Sub test10() '区分大小写,默认不写是区分的,因此我们只有在不区分时才补上这句
    Dim dic
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    dic.Add "D", 0
    dic.Add "d", 0
    '因为默认的是区域大小写的,所以不报错
End Sub
Sub test11() '不区分大小写,
    Dim dic
    Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典对象
    dic.CompareMode = 1
    dic.Add "D", 0
    dic.Add "d", 0
    '上面的代码报错了,因为dic.CompareMode = 1不区分大小写,所以
    '你装后大写的D之后,再装小写的d,重装了,报错
End Sub