Excel VBA（04）数组和字典

数组

一、数组基本概念

• 一维、二维和三维数组

1、常量数组

array(1,2,3)
array(array(1,2,3),array("1","2","3"))

2、静态数组

arr(5) '五个元素，下标从0开始
arr(1 to 5) '五个元素，下标从1开始
arr(1 to 5,1 to 10) '二维数组，五行十列

3、动态数组

• 动态数组确定元素的个数再进行redim，可以多次redim 调整容量
• 就是可以动态确定数组的行和列

dim arr1()
dim i as integer
i = 10
redim arr(i)

Sub test()
    Dim arr
    Dim i As Integer
    i = 10
    ReDim arr(i)
    arr(1) = 123
    Debug.Print arr(1)
    ReDim arr(20)
    arr(19) = 188888
    Debug.Print arr(19)
End Sub

excel 提示框的启用和禁用：application.displayalerts = true

二、数组的读写

1、向数组写入数据

• 常量数组可以直接赋值给一个变量即可使用
• 静态和动态的数组通过循环进行赋值，可以直接指定位置进行赋值
• 用单元格的区域进行赋值的时候要注意，只能赋值给一个普通的变量，然后这个变量就指向了包含行列的二维数组，不能给明确定义的数组变量进行range的批量赋值

2、从数组中读取数据

• 可以直接将数组的赋值给单元格区域，需要注意的是，数组元素个数需要大于等于单元格数量，否则会出现错误，数组元素多了的话就是部分存进单元格，少了会出现错误的值
• 一般的使用中为了提高代码运行的效率都是将单元格区域存入数组，进行加工处理后，再重新赋值到单元格这样速度会有所提升
• 一维数组的话对应的是表的行，直接可以赋值到行，如果要赋值到列的话需要转置

Sub test()
    Dim arr(1 To 3)
    For i = 1 To 3
        arr(i) = i * 10
    Next i   
    Sheets(1).Range("a10").Resize(3, 1) = Application.Transpose(arr)  
End Sub

• 只要是单元格区域赋值到变量，那么这个变量指向的就是一个二维的数组，哪怕单元格的区域就是一行或者一列

Sub test()
    Dim arr, arr1
    arr = Range("a1:c1")
    arr1 = Range("a1:a10")
    Stop
End Sub

注意：一维数组的下标默认是从 0开始的，二维数组的下标默认是从 1开始的

3、动态扩容

数组的大小

• 一维数组：ubound(arr)索引上界 lbound(arr)索引下界
• 二维数组：ubound(arr,1) lbound(arr,1)行的索引上界和下界，其中的1换成2就是列了

动态扩容

• 一维数组的扩容很简单，二维数组的扩容是针对列的，行是无法实直接现扩容的
• 一般二维数组扩容行的话都是通过转置来实现的，先把行转列，扩容完后将列转行
• 但是一般不这么玩，直接将行定义足够大即可，不是很追求性能和效率的话

Sub test()
    Dim arr, arr2()
    arr = Array(1, 2, 3)
    For i = 0 To UBound(arr):
        ReDim Preserve arr2(i)
        arr2(i) = arr(i)
    Next i
    Debug.Print UBound(arr)
End Sub

'二维数组
Sub test()
    Dim arr, arr2()
    arr = Range("a1:d4")
    Dim x, k As Integer
    For x = 1 To UBound(arr):
        k = k + 1
        ReDim Preserve arr2(1 To 4, 1 To k)
        arr2(1, k) = arr(x, 1)
        arr2(2, k) = arr(x, 2)
        arr2(3, k) = arr(x, 3)
        arr2(4, k) = arr(x, 4)
    Next x
    Range("a8").Resize(k, 4) = Application.Transpose(arr2)        
End Sub

4、清空数组

• 数组的清空使用 erase

Sub test()
    Dim arr, arr2()
    arr = Array(1, 2, 3)
    Erase arr
End Sub

5、示例练习

• 最终要实现的效果就是将 b 列中大于100的行填充为红色
  

Sub test11()
    Dim str, arr, allrows, x, x1
    allrows = Range("a65535").End(xlUp).Row
    arr = Application.Transpose(Range("b1:" & "b" & allrows))
    For x = 1 To UBound(arr)
        If arr(x) > 100 Then
            x1 = x
            If x <> UBound(arr) Then
                Do
                    x = x + 1
                Loop While arr(x) > 100
                str = str & x1 & ":" & x - 1 & ","
            Else
                str = str & x1 & ":" & x & ","
            End If
            If Len(str) > 10 Then
                Intersect(Range("a:b"), Range(Left(str, Len(str) - 1))).Interior.ColorIndex = 3
            End If
        End If
        If x = UBound(arr) Then
            Intersect(Range("a:b"), Range(Left(str, Len(str) - 1))).Interior.ColorIndex = 3
        End If
      Next x
End Sub

三、数组和函数

• 用一些函数来操作数组可以大大简化我们的编程

1、最值

• application.max|min|large(arr,2)|small
• 其中的 large 后面的数字可以指定第几大的，small 也是一样的

2、求和

• application.sum

3、统计个数

• application.count 统计数字的个数
• counta 统计填充的字符数

4、数组查找

• application.match("ab",arr,0)
• 很多类似的可以用来在单元格区域使用函数都可以用在数组上，因为二者在vba中本质都是数组

5、其他函数

• split 和 join：vba的内置函数可以省略vba.split的写法直接使用

Sub test()
    Dim te
    te = "ha-ll-o"
    arr = Split(te, "-")
    ha = Join(arr, "|")
End Sub

• filter：测试发现好像只能针对一维数据进行过滤

Sub test()
    Dim arr, arr1
    arr = Range("a1:b1")
    arr1 = Filter(Application.Index(arr, 1, 0), "h", True)   
End Sub

• index：后面的两个数字分别是行列的索引，数字为0代表取整行或者整列

Sub test()
    Dim rg
    rg = Range("a1:d4")
    arr = Application.Index(rg, 0, 1)
End Sub

• vlookup：倒数第一个参数true或false代表精确或模糊匹配，第二个参数代表查找匹配项的列数

Sub test()
    Dim arr, arr1
    arr = Range("a1:d6")
    arr1 = Application.VLookup(Array("h", "h123"), arr, 1, 1) 
    Stop
End Sub

• sumif 和 countif

四、数组排序

1、冒泡

2、选择

3、插入

4、希尔

关于排序的详解介绍参考博文：十大经典排序算法

---

字典

一、字典的基本概念

• vba中的字典的概念和 python 中的字典的概念是一致的，就是用来存储键值对的集合
• 取出所有的键可以使用 keys ，取出所有的项可以使用 items
• 键值不允许重复，item 可以
• 字典的特点就是可以实现快速查找
• 局限在于只能包含两列

二、创建字典

1、直接创建

Sub test()
    Dim dict
    Set dict = CreateObject("scripting.dictionary")
    dict("a") = 12
    MsgBox dict("a")
End Sub

2、引入相应的支持库

• 下面的代码需要引入支持库才可以使用

Sub test()
    Dim dict As New Dictionary
    dict("h") = "hello"
    Debug.Print dict("h")   
End Sub

三、字典操作

1、装入数据

• 这样装入数据如果键值重复的话会发生错误

dict.add cells(1,1).value ,cells(1,2).value

2、读取数据

Sub test()
    Dim dict As New Dictionary
    dict.Add "h", "hello"
    dict.Add "h1", "123"
    Range("a1").Resize(dict.Count) = Application.Transpose(dict.Keys)
    Range("b1").Resize(dict.Count) = Application.Transpose(dict.Items) 
End Sub

3、修改数据

• 这样的赋值就能修改数据了，如果不存在的话就是新增一个

dict("h") = 1234
dict("h") = "hello"

4、删除数据

Sub test()
    Dim dict As New Dictionary
    dict.Add "h", "hello"
    dict.Add "h1", "123"
    dict.Remove ("h")
    MsgBox dict.Exists("h")
    dict.RemoveAll
    MsgBox dict.Count
End Sub

• 区分大小：binaryCompare设置的话区分大小写，TextCompare不区分大小写

Sub test()
    Dim dict As New Dictionary
    dict.CompareMode = TextCompare
    dict.Add "h", "hello"
    dict.Add "H", "123"
End Sub

四、数组字典联合使用之下棋法

• 核心就是确定数据的行数和列数，基本的应用就是对重复项进行汇总

Sub test()
    Dim hang As Integer, maxrow As Integer
    Dim arr, arr2
    Dim arr3 As New Dictionary
    maxrow = Range("a65536").End(xlUp).Row
    arr = Range("a1:b" & maxrow)
    For i = 1 To UBound(arr)
        If arr3.Exists(arr(i, 1)) Then
            Range("e" & arr3(arr(i, 1))) = Range("e" & arr3(arr(i, 1))) + arr(i, 2)
        Else
            hang = hang + 1
            arr3(arr(i, 1)) = hang
            Range("d" & hang) = arr(i, 1)
            Range("e" & hang) = arr(i, 2)
        End If
    Next i        
End Sub