美文网首页
VBA字典对象操作技巧

VBA字典对象操作技巧

作者: Stone0823 | 来源:发表于2021-12-17 16:25 被阅读0次

    VBA 中集合的功能比较弱,常见的有数组 (array) 、集合 (Collection)和字典,其中字典是 Key-Value Pair 类型的数据结构,适合按 Key 存储和查找。本篇介绍字典的操作方法。

    VBA 语法本身并没有字典这种数据结构,需要引用 Microsft Scripting Runtime 库:

    Dictionary 本身的方法不多,只有六个:


    From: Dictionary 对象 | Microsoft Docs

    创建字典对象并添加值

    我们使用前期绑定的方式,new Dictionary() 创建字典对象,Add() 方法添加元素

    Public Sub CreateDictionary()
        Dim d As New Dictionary
        d.Add "a", "Athens"
        d.Add "b", "Belgrade"
        d.Add "c", "Cairo"    
    End Sub
    

    遍历字典

    1. 通过 Keys 属性遍历
    Public Sub IterateThruKeys()
        Dim d As New Dictionary
        d.Add "a", "Athens"
        d.Add "b", "Belgrade"
        d.Add "c", "Cairo"
        
        Dim k As Variant ' 只能为variant或者object类型
        For Each k In d.Keys
            Debug.Print k, d(k)
        Next
    End Sub
    

    VBA 表示集合的元素用的也是圆括号,不像其它语言一般用方括号。

    1. 遍历值
    Public Sub IterateThruItems()
        Dim d As New Dictionary
        d.Add "a", "Athens"
        d.Add "b", "Belgrade"
        d.Add "c", "Cairo"
        
        Dim v As Variant
        For Each v In d.Items
            Debug.Print v
        Next
    End Sub
    
    1. 通过 Count 遍历
    Public Sub IterateThruCount()
        Dim d As New Dictionary
        d.Add "a", "Athens"
        d.Add "b", "Belgrade"
        d.Add "c", "Cairo"
        
        Dim i As Integer
        For i = 0 To d.Count - 1
            Debug.Print d.Keys(i), d.Items(i)
        Next
    End Sub
    

    下面通过一些小例子加深大家的理解,掌握一些重要的编码方法。

    判断 key 是否存在

    Public Sub CheckIfExists()
        Dim d As New Dictionary
        Dim i As Integer
    
        d.Add "a", "Athens"
        d.Add "b", "Belgrade"
        d.Add "c", "Cairo"
        
        If d.Exists("a") Then Debug.Print d("a")
    End Sub
    

    将字典的key和value写入工作表

    Public Sub WriteToSheet()
        Dim d As New Dictionary
        d.Add "a", "Athens"
        d.Add "b", "Belgrade"
        d.Add "c", "Cairo"
        
        Sheet1.Cells(1, 1).Resize(1, d.Count) = d.Keys
        Sheet1.Cells(2, 1).Resize(1, d.Count) = d.Items
    End Sub
    

    执行代码后,字典的值被写入到 Sheet1,界面如下:

    image

    竖向表达感觉会更直观,下面的代码实现列示呈现:

    Public Sub WriteToSheet2()
        Dim d As New Dictionary
        d.Add "a", "Athens"
        d.Add "b", "Belgrade"
        d.Add "c", "Cairo"
        
        Dim i As Integer
        For i = 0 To d.Count - 1
            Sheet1.Range("A1").Offset(i, 0) = d.Keys(i)
            Sheet1.Range("A1").Offset(i, 1) = d.Items(i)
        Next
    End Sub
    

    效果:

    将 Sheet 中的值转换为字典

    如果已经有了如上图在 Excel 工作表的值,下面的代码则将这些值转换为字典:

    Public Sub ConvertSheetValueToDict()
        Dim d As New Dictionary
        Dim i As Integer
        Dim startCell As Range
        Set startCell = Sheet1.Range("A1")
        For i = 0 To startCell.CurrentRegion.Rows.Count
            d.Add startCell.Offset(i, 0).Value, startCell.Offset(i, 1).Value
        Next
        
        Dim k As Variant
        For Each k In d.Keys
            Debug.Print k, d(k)
        Next
    End Sub
    

    下面给出两个利用字典进行计算的示例。

    利用字典进行求和计算

    假设我们有如下的左边数据,要实现按品种进行统计:

    Public Sub CalculateUsingDict()
        Dim d As New Dictionary
        Dim tbl As Range
        Dim dataRange As Range
        
        ' 不包括表头
        Set tbl = Sheet2.Range("A1").CurrentRegion
        Set dataRange = tbl.CurrentRegion.Offset(1, 0)
            
        Dim row As Range
        Dim cell As Range
        Dim key As String
        For Each row In dataRange.Rows
            key = CStr(row.Cells(1))
            If Not d.Exists(key) Then
                d.Add key, row.Cells(2)
            Else
                d(key) = d(key) + row.Cells(2)
            End If
        Next
        
        Dim k As Variant
        Dim i As Integer
        For i = 0 To d.Count - 1
            Sheet2.Range("H2").Offset(i, 0) = d.Keys(i)
            Sheet2.Range("H2").Offset(i, 1) = d.Items(i)
        Next
    End Sub
    

    这里用到了一个小技巧,因为数据包含表头,所以通过变量 dataRange 只包含数据部分,不包括表头。

    通过字典进行匹配

    假设有如下图左边的数据,需要实现按姓名查找学生三门课的考试成绩,类似 vlookup。

    Public Sub MatchUsingDict()
        Dim d As New Dictionary
        Dim tbl As Range
        Dim dataRange As Range
        
        Set tbl = Sheet3.Range("A1").CurrentRegion
        Set dataRange = tbl.CurrentRegion.Offset(1, 0)
            
        Dim row As Range
        Dim cell As Range
        Dim k As String
        Dim v As Variant
        For Each row In dataRange.Rows
            k = CStr(row.Cells(1))
            v = Array(row.Cells(2), row.Cells(3), row.Cells(4))
            d.Add k, v
        Next
        
        Dim key As String
        key = CStr(Sheet3.Range("H2"))
        If d.Exists(key) Then
            Sheet3.Range("H2").Offset(0, 1) = d(key)(0)
            Sheet3.Range("H2").Offset(0, 2) = d(key)(1)
            Sheet3.Range("H2").Offset(0, 3) = d(key)(2)
        End If
    End Sub
    

    有兴趣的小伙伴,甚至可以利用 dictionary 编写类似 vlookup 的函数,自己琢磨吧。

    相关文章

      网友评论

          本文标题:VBA字典对象操作技巧

          本文链接:https://www.haomeiwen.com/subject/kbmifrtx.html