VBA进阶 | Dictionary对象应用大全6：常用操作（续3）

复制Dictionary对象中的元素

可以将已存在的元素内容赋值给另一个元素或者新键。

Sub CopyItem()

    WithCreateObject('scripting.dictionary')

        .Item('aa') = 'the firstitem'

        .Item('bb') =.Item('aa')

        MsgBox .Item('bb')

    End With

End Sub

 

修改Dictionary对象中元素的内容

示例1：替换Dictionary对象中已有元素的内容

使用Item属性将使用同一键的新元素内容替换已有的元素内容。

Sub ChangeItem1()

    Dim it

    WithCreateObject('scripting.dictionary')

        For Each it In Array('aa1','aa2', 'aa3', 'aa4', 'aa5','aa6')

            .Item(it) = it &'_content'

        Next

        For Each it In Array('aa1','aa2', 'aa5', 'aa6')

            .Item(it) = it & '_newcontent'

        Next

 

        MsgBox Join(.Items, '|')

    End With

End Sub

示例2：在已存在的元素内容中添加数据

仅应用于包含单精度数字、字符串或日期的元素内容。

Sub ChangeItem2()

    Dim it

    WithCreateObject('scripting.dictionary')

        For Each it In Array('aa1','aa2', 'aa1', 'aa3', 'aa4','aa2')

            .Item(it) = 'aa'

        Next

        For Each it In Array('aa1','aa2', 'aa1', 'aa3', 'aa4','aa2')

            .Item(it) = .Item(it) &'_bb'

        Next

 

        MsgBox Join(.Items, '|')

    End With

End Sub

示例3：对元素内容执行计算

仅应用于包含单精度数字、字符串、日期或布尔值的元素。

（1）数字

Sub CalcItem1()

    Dim it

    WithCreateObject('scripting.dictionary')

        For Each it In Array('aa1','aa2', 'aa1', 'aa3', 'aa4','aa2')

            .Item(it) = 10

        Next

        For Each it In Array('aa1','aa2', 'aa1', 'aa3', 'aa4','aa2')

            .Item(it) = .Item(it) 40

        Next

 

        MsgBox Join(.Items, '|')

    End With

End Sub

（2）日期

Sub CalcItem2()

    Dim it

    WithCreateObject('scripting.dictionary')

        For Each it In Array('aa1','aa2', 'aa3', 'aa4')

            .Item(it) = Date .Count

        Next

        For Each it In Array('aa1','aa2', 'aa3', 'aa4')

            .Item(it) = DateAdd('m',1, .Item(it))

        Next

 

        MsgBox Join(.Items, vbLf)

    End With

End Sub

（3）布尔值

Sub CalcItem3()

    Dim it

    With CreateObject('scripting.dictionary')

        For Each it In Array('aa1','aa2', 'aa3', 'aa4', 'aa2')

            .Item(it) = False

        Next

        For Each it In Array('aa1','aa2', 'aa3', 'aa4', 'aa2')

            .Item(it) = Format(.Item(it),'Yes/No')

        Next

 

        MsgBox Join(.Items, '|')

    End With

End Sub

示例4：修改内容包含数组的元素

（1）一维数组

读取包含数组内容的元素的代码：

WithCreateObject('scripting.dictionary')

.Item('aa') = Array('zz1','zz2', 'zz3', 'zz4')
MsgBox .Item('aa')(3)

End With

如果以下面的代码来修改包含数组的元素内容，虽然不会报错，但元素也不会被修改。

WithCreateObject('scripting.dictionary')

.Item('aa') = Array('zz1','zz2', 'zz3', 'zz4')
MsgBox .Item('aa')(3)

.Item('aa')(3) = 'the fourth item is ' &.Item('aa')(3)
MsgBox .Item('aa')(3)

End With

可以使用一种变通的方式，即先将数组读取到变量中，然后修改该数组变量的一个或多个元素，最后使用该数组变量替换字典元素的内容。

WithCreateObject('scripting.dictionary')

    .Item('aa') =Array('zz1', 'zz2', 'zz3', 'zz4')

 

    sn = .Item('aa')

    sn(3) = 'the fourth element is '& sn(3)

    .Item('aa') = sn

 

    MsgBox .Item('aa')(3)

End With

（2）二维数组

要从包含二维数组的Dictionary对象元素中读取元素内容，可以使用下面的代码：

WithCreateObject('scripting.dictionary')

    ReDim sn(3, 4)

    For j = 0 To UBound(sn)

        For jj = 0 To UBound(sn, 2)

            sn(j, jj) = j 5 * jj

        Next

    Next

 

    .Item('aa') = sn

    MsgBox .Item('aa')(2, 3)

End With

与一维数组一样，如果使用下面的代码直接替换字典元素数组中的内容，没有效果。

WithCreateObject('scripting.dictionary')

ReDim sn(3, 4)
For j = 0 To UBound(sn)

For jj = 0 To UBound(sn, 2)

sn(j, jj) = j 5 * jj

Next

Next
.Item('aa') = sn

MsgBox .Item('aa')(2, 3)

.Item('aa')(2, 3) = 10 * .Item('aa')(2, 3)
MsgBox .Item('aa')(2, 3)

End With

此时，可以选将元素内容数组读取到数组变量中，然后修改该数组变量的一个或多个元素，最后使用该数组变量替换Dictionary中元素的内容。

WithCreateObject('scripting.dictionary')

ReDim sn(3, 4)

For j = 0 To UBound(sn)

For jj = 0 To UBound(sn, 2)

sn(j, jj) = j 5 * jj

Next

Next
.Item('aa') = sn

MsgBox .Item('aa')(2, 3)

sp = .Item('aa')
sp(2, 3) = 10 * sp(2, 3)
.Item('aa') = sp

MsgBox .Item('aa')(2, 3)

End With

 

从Dictionary对象中的删除元素

删除某个元素：

Sub DeleteItem()

    Dim it

    With CreateObject('scripting.dictionary')

        For Each it In Array('aa1','aa2', 'aa3', 'aa4', 'aa2')

            .Item(it) = it &'_content'

        Next

 

        .Remove 'aa3'

    End With

End Sub

删除所有元素：

Sub DeleteAllItems()

    Dim it

    With CreateObject('scripting.dictionary')

        For Each it In Array('2','33', 'aa3', 'aa4', 'aa2')

            .Item(it) = it &'_content'

        Next

        .RemoveAll

    End With

End Sub

---

本文属原创文章，转载请注明出处。

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。