VBA字典(dictionary)

最新推荐文章于 2023-10-14 14:14:04 发布

Gordennizaicunzai

最新推荐文章于 2023-10-14 14:14:04 发布

阅读量1.5w

点赞数 15

分类专栏： VBA 文章标签： VBA字典 dictionary

VBA 专栏收录该内容

19 篇文章

订阅专栏

这是我看到的最简单明了的Excel VBA字典(dictionary)的教程，把字典的应用，用短短几百字，全部道尽，简！但精彩！原文如下：

当年我(原作者：彭希仁)向LDY版主求教字典的时候，他老人家总结了一句话“呼之即来，挥之即去”
即学会d(a)=s 和 s=d(a) 就差不多了，忘记ADD存在。

一、定义字典

Set d = CreateObject("Scripting.Dictionary")

二、呼之即来，挥之即去

d("张三“)=1     '相当于给字典赋值，张三过来（没有就生成）拿个1站一边去
d("李四”)=2     '相当于给字典赋值，李四过来（没有就生成）拿个2站一边去
d("李四”)=3     '相当于改变值，字典中已经有李四了，李四跑过来，丢下2换个3站一边去
注：这时字典中有两个人的存在，张三＝1 和李四＝3，相当于实现了去重复的功能

s=d("张三")    's=1   即叫了声张三，张三就告诉你他拿的是1
s=d("李四")    's=3   即叫了声李四，李四就告诉你他拿的是3
s=d("麻子")    's="" 没有找到麻子怎么办呢，字典里就自动生成一个麻子d("麻子") ＝“”，告诉你他手上是空的
注：这时字典中有三个人的存在，张三＝1 ; 李四＝3;麻子＝“”

三、将字典里的东西变成数组

arr= d.Keys '把名字的集合按先来后到的原则放到一维数组里 arr(0)＝“张三” ; arr(1)＝“李四” ; arr(2)＝“麻子”
arr1=d.Items '把名字对应的值的集合按先来后到的原则放到一维数组里 arr1(0)＝“1” ; arr1(1)＝“3” ; arr1(2)＝“”

四、查找字典中有没有这个人

s=d.Exists(“张三”) 's=True 有的
s=d.Exists(“http://www.excelba.com”) 's=False 没有

五、清空数组

d.RemoveAll

是不是简单呢？

上文出处：http://club.excelhome.net/thread-926188-1-1.html

Sub 宏1()
    Set dic = CreateObject("Scripting.Dictionary") '字典
    For i = 1 To 10000
    If Not i Like "*4*" Then
        dic.Add i, "" '如果不包含“1”
    End If
    Next i
    Range("a2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) '
End Sub

Tranpose工作表函数的用法实例，把一行多列的二维数组转换成一维数组。

Sub 宏2()
    Dim arr, arrt
    arr = Range("a1:j1")
    arrt = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))
End Sub

e.g:

Sub 字典()
    Dim arr()
    Dim i As Integer
    Dim j As Integer
    Dim Mrow As Integer
    Dim rng As String
    Mrow = ActiveSheet.Range("A65536").End(xlUp).Row
    rng = Range("A" & Mrow).Address(0, 0)
    Set d = CreateObject("scripting.dictionary")
    [B2:B65535] = ""
    arr = Range("A2", rng)
    For i = 1 To UBound(arr)
        'If i = 2 Then
            d(arr(i, 1)) = i
        'Else
            'd(arr(i, 1)) = ""
        'End If
    Next i
    'Sheet1.Cells(2, 1).Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
    '对字典进行循环
    K = d.keys
    V = d.Items
    For j = 0 To d.Count - 1
        Sheet1.Cells(j + 1, 3) = K(j)
        Sheet1.Cells(j + 1, 4) = V(j)
    Next j
    d.RemoveAll
    Set d = Nothing
    Set K = Nothing
    Set V = Nothing
End Sub