VBA基础知识整理（字典，自定义函数）

字典
基本概念

'1 什么是VBA字典？'字典（dictionary）是一个储存数据的小仓库。共有两列。'第一列叫key , 不允许有重复的元素。'第二列是item,每一个key对应一个item，本列允许为重复'Key   item'A     10'B     20'C     30'Z     10'2 即然有数组，为什么还要学字典？'原因:提速，具体表现在'1) A列只能装入非重复的元素，利用这个特点可以很方便的提取不重复的值'2) 每一个key对应一个唯一的item，只要指点key的值，就可以马上返回其对应的item，利用字典可以实现快速的查找'3 字典有什么局限？'字典只有两列，如果要处理多列的数据，还需要通过字符串的组合和拆分来实现。'字典调用会耗费一定时间，如果是数据量不大，字典的优势就无法体现出来。'4 字典在哪里？如何创建字典？'字典是由scrrun.dll链接库提供的，要调用字典有两种方法'第一种方法：直接创建法'Set d = CreateObject("scripting.dictionary")'第二种方法：引用法'工具-引用-浏览-找到scrrun.dll-确定

字典操作

'1 装入数据Sub t1()Dim d As New DictionaryDim x As IntegerFor x = 2 To 4d.Add Cells(x, 1).Value, Cells(x, 2).ValueNext xMsgBox d.Keys(1)'StopEnd Sub------------------------

'2 读取数据

 Sub t2()Dim dDim arrDim x As IntegerSet d = CreateObject("scripting.dictionary")For x = 2 To 4d.Add Cells(x, 1).Value, Cells(x, 2).ValueNext x'MsgBox d("李四")'MsgBox d.Keys(2)Range("d1").Resize(d.Count) = Application.Transpose(d.Keys)  '关键字Range("e1").Resize(d.Count) = Application.Transpose(d.Items)	‘元素arr = d.ItemsEnd Sub

3 修改数据

Sub t3()Dim d As New DictionaryDim x As IntegerFor x = 2 To 4d.Add Cells(x, 1).Value, Cells(x, 2).ValueNext xd("李四") = 78MsgBox d("李四")d("赵六") = 100MsgBox d("赵六")
End Sub

'4 删除数据

Sub t4()Dim d As New DictionaryDim x As IntegerFor x = 2 To 4d(Cells(x, 1).Value) = Cells(x, 2).ValueNext xd.Remove "李四"' MsgBox d.Exists("李四")d.RemoveAllMsgBox d.Count
End Sub

'区分大小写

 Sub t5()Dim d As New DictionaryDim xFor x = 1 To 5d(Cells(x, 1).Value) = ""Next xStopEnd Sub

字典与查找

Sub 多表双向查找()Dim d As New DictionaryDim x, yDim arrFor x = 3 To 5arr = Sheets(x).Range("a2").Resize(Sheets(x).Range("a65536").End(xlUp).Row - 1, 2)For y = 1 To UBound(arr)d(arr(y, 1)) = arr(y, 2)d(arr(y, 2)) = arr(y, 1)Next yNext xMsgBox d("C1")MsgBox d("吴情")
End Sub

字典与求和

Sub 汇总()Dim d As New DictionaryDim arr, xarr = Range("a2:b10")For x = 1 To UBound(arr)d(arr(x, 1)) = d(arr(x, 1)) + arr(x, 2) 'key对应的item的值在原来的基础上加新的Next xRange("d2").Resize(d.Count) = Application.Transpose(d.Keys)Range("e2").Resize(d.Count) = Application.Transpose(d.Items)
End Sub

字典与唯一值

Sub 提取不重复的产品()Dim d As New DictionaryDim arr, xarr = Range("a2:a12")For x = 1 To UBound(arr)d(arr(x, 1)) = ""Next xRange("c2").Resize(d.Count) = Application.Transpose(d.Keys)
End Sub

多列汇总

Sub 下棋法之多列汇总()Dim 棋盘(1 To 10000, 1 To 3)Dim 行数Dim arr, x, kDim d As New Dictionaryarr = Range("a2:c" & Range("a65536").End(xlUp).Row)For x = 1 To UBound(arr)If d.Exists(arr(x, 1)) Then行数 = d(arr(x, 1))棋盘(行数, 2) = 棋盘(行数, 2) + arr(x, 2)棋盘(行数, 3) = 棋盘(行数, 3) + arr(x, 3)Elsek = k + 1d(arr(x, 1)) = k棋盘(k, 1) = arr(x, 1)棋盘(k, 2) = arr(x, 2)棋盘(k, 3) = arr(x, 3)End IfNext xRange("f2").Resize(k, 3) = 棋盘
End Sub

多条件多列汇总

Sub 下棋法之多条件多列汇总()Dim 棋盘(1 To 10000, 1 To 4)Dim 行数Dim arr, x As Integer, sr As String, k As IntegerDim d As New Dictionaryarr = Range("a2:d" & Range("a65536").End(xlUp).Row)For x = 1 To UBound(arr)sr = arr(x, 1) & "-" & arr(x, 2)If d.Exists(sr) Then行数 = d(sr)棋盘(行数, 3) = 棋盘(行数, 3) + arr(x, 3)棋盘(行数, 4) = 棋盘(行数, 4) + arr(x, 4)Elsek = k + 1d(sr) = k棋盘(k, 1) = arr(x, 1)棋盘(k, 2) = arr(x, 2)棋盘(k, 3) = arr(x, 3)棋盘(k, 4) = arr(x, 4)End IfNext xRange("g2").Resize(k, 4) = 棋盘
End Sub

数据透视式汇总

Sub 下棋法之数据透视表式汇总()Dim d As New DictionaryDim 棋盘(1 To 10000, 1 To 7)Dim 行数, 列数Dim arr, x, karr = Range("a2:c" & Range("a65536").End(xlUp).Row)For x = 1 To UBound(arr)列数 = (InStr("1月2月3月4月5月6月", arr(x, 2)) + 1) / 2 + 1If d.Exists(arr(x, 1)) Then行数 = d(arr(x, 1))棋盘(行数, 列数) = 棋盘(行数, 列数) + arr(x, 3)Elsek = k + 1d(arr(x, 1)) = k棋盘(k, 1) = arr(x, 1)棋盘(k, 列数) = arr(x, 3)End IfNext xRange("f2").Resize(k, 7) = 棋盘End Sub

自定义函数

什么是自定义函数

'1 什么是自定义函数？'在VBA中有VBA函数，我们还可以调用工作表函数，我们能不能自已编写函数呢？可以，这就是本集所讲的自定义函数'2 怎么编写自定义函数？'我们可以按下面的结构编写自定义函数' Function 函数名称(参数1,参数2....)'代码'函数名称=返回的值或数组set 返回集合对象' End Function

编写和使用自定义函数
'1 取得工作表总个数的自定义函数

Function shcount()shcount = Sheets.CountEnd Function----------------------------------
Sub dd()MsgBox getv(Range("a7"))
End Sub

'2 取得单元格显示值的自定义函数

  Function getv(rg As Range)getv = rg.TextEnd Function

'3 截取字符串的函数

 Function jiequ(sr As String, fh As String, wz As Integer)Dim ArrArr = Split(sr, fh)jiequ = Arr(wz - 1)End Function-----------------------------------------------------Sub test()MsgBox jiequ("A-BRT-C-EF", "-", 2)End Sub

'4 提取不重复值的个数

  Function 不重复个数(rg As Range)Dim d, Arr, arArr = rgSet d = CreateObject("scripting.dictionary")For Each ar In Arrd(ar) = ""Next ar不重复个数 = d.CountEnd Function

参数值默认和参数缺省

Function shuiji2(maxnum, geshu, Optional qo As Integer = 2)Dim d As New DictionaryDim num, mApplication.Volatilem = 1Donum = Int(Rnd() * maxnum + 1)If qo = 2 ThenIf num Mod 2 = 0 Then d(num) = ""ElseIf qo = 1 ThenIf Not num Mod 2 = 0 Then d(num) = ""ElseExit FunctionEnd IfLoop Until d.Count = geshushuiji2 = Application.Transpose(d.Keys)
End Function  

VBA基础知识整理（字典，自定义函数）

字典
基本概念

'1 什么是VBA字典？'字典（dictionary）是一个储存数据的小仓库。共有两列。'第一列叫key , 不允许有重复的元素。'第二列是item,每一个key对应一个item，本列允许为重复'Key   item'A     10'B     20'C     30'Z     10'2 即然有数组，为什么还要学字典？'原因:提速，具体表现在'1) A列只能装入非重复的元素，利用这个特点可以很方便的提取不重复的值'2) 每一个key对应一个唯一的item，只要指点key的值，就可以马上返回其对应的item，利用字典可以实现快速的查找'3 字典有什么局限？'字典只有两列，如果要处理多列的数据，还需要通过字符串的组合和拆分来实现。'字典调用会耗费一定时间，如果是数据量不大，字典的优势就无法体现出来。'4 字典在哪里？如何创建字典？'字典是由scrrun.dll链接库提供的，要调用字典有两种方法'第一种方法：直接创建法'Set d = CreateObject("scripting.dictionary")'第二种方法：引用法'工具-引用-浏览-找到scrrun.dll-确定

字典操作

'1 装入数据Sub t1()Dim d As New DictionaryDim x As IntegerFor x = 2 To 4d.Add Cells(x, 1).Value, Cells(x, 2).ValueNext xMsgBox d.Keys(1)'StopEnd Sub------------------------

'2 读取数据

 Sub t2()Dim dDim arrDim x As IntegerSet d = CreateObject("scripting.dictionary")For x = 2 To 4d.Add Cells(x, 1).Value, Cells(x, 2).ValueNext x'MsgBox d("李四")'MsgBox d.Keys(2)Range("d1").Resize(d.Count) = Application.Transpose(d.Keys)  '关键字Range("e1").Resize(d.Count) = Application.Transpose(d.Items)	‘元素arr = d.ItemsEnd Sub

3 修改数据

Sub t3()Dim d As New DictionaryDim x As IntegerFor x = 2 To 4d.Add Cells(x, 1).Value, Cells(x, 2).ValueNext xd("李四") = 78MsgBox d("李四")d("赵六") = 100MsgBox d("赵六")
End Sub

'4 删除数据

Sub t4()Dim d As New DictionaryDim x As IntegerFor x = 2 To 4d(Cells(x, 1).Value) = Cells(x, 2).ValueNext xd.Remove "李四"' MsgBox d.Exists("李四")d.RemoveAllMsgBox d.Count
End Sub

'区分大小写

 Sub t5()Dim d As New DictionaryDim xFor x = 1 To 5d(Cells(x, 1).Value) = ""Next xStopEnd Sub

字典与查找

Sub 多表双向查找()Dim d As New DictionaryDim x, yDim arrFor x = 3 To 5arr = Sheets(x).Range("a2").Resize(Sheets(x).Range("a65536").End(xlUp).Row - 1, 2)For y = 1 To UBound(arr)d(arr(y, 1)) = arr(y, 2)d(arr(y, 2)) = arr(y, 1)Next yNext xMsgBox d("C1")MsgBox d("吴情")
End Sub

字典与求和

Sub 汇总()Dim d As New DictionaryDim arr, xarr = Range("a2:b10")For x = 1 To UBound(arr)d(arr(x, 1)) = d(arr(x, 1)) + arr(x, 2) 'key对应的item的值在原来的基础上加新的Next xRange("d2").Resize(d.Count) = Application.Transpose(d.Keys)Range("e2").Resize(d.Count) = Application.Transpose(d.Items)
End Sub

字典与唯一值

Sub 提取不重复的产品()Dim d As New DictionaryDim arr, xarr = Range("a2:a12")For x = 1 To UBound(arr)d(arr(x, 1)) = ""Next xRange("c2").Resize(d.Count) = Application.Transpose(d.Keys)
End Sub

多列汇总

Sub 下棋法之多列汇总()Dim 棋盘(1 To 10000, 1 To 3)Dim 行数Dim arr, x, kDim d As New Dictionaryarr = Range("a2:c" & Range("a65536").End(xlUp).Row)For x = 1 To UBound(arr)If d.Exists(arr(x, 1)) Then行数 = d(arr(x, 1))棋盘(行数, 2) = 棋盘(行数, 2) + arr(x, 2)棋盘(行数, 3) = 棋盘(行数, 3) + arr(x, 3)Elsek = k + 1d(arr(x, 1)) = k棋盘(k, 1) = arr(x, 1)棋盘(k, 2) = arr(x, 2)棋盘(k, 3) = arr(x, 3)End IfNext xRange("f2").Resize(k, 3) = 棋盘
End Sub

多条件多列汇总

Sub 下棋法之多条件多列汇总()Dim 棋盘(1 To 10000, 1 To 4)Dim 行数Dim arr, x As Integer, sr As String, k As IntegerDim d As New Dictionaryarr = Range("a2:d" & Range("a65536").End(xlUp).Row)For x = 1 To UBound(arr)sr = arr(x, 1) & "-" & arr(x, 2)If d.Exists(sr) Then行数 = d(sr)棋盘(行数, 3) = 棋盘(行数, 3) + arr(x, 3)棋盘(行数, 4) = 棋盘(行数, 4) + arr(x, 4)Elsek = k + 1d(sr) = k棋盘(k, 1) = arr(x, 1)棋盘(k, 2) = arr(x, 2)棋盘(k, 3) = arr(x, 3)棋盘(k, 4) = arr(x, 4)End IfNext xRange("g2").Resize(k, 4) = 棋盘
End Sub

数据透视式汇总

Sub 下棋法之数据透视表式汇总()Dim d As New DictionaryDim 棋盘(1 To 10000, 1 To 7)Dim 行数, 列数Dim arr, x, karr = Range("a2:c" & Range("a65536").End(xlUp).Row)For x = 1 To UBound(arr)列数 = (InStr("1月2月3月4月5月6月", arr(x, 2)) + 1) / 2 + 1If d.Exists(arr(x, 1)) Then行数 = d(arr(x, 1))棋盘(行数, 列数) = 棋盘(行数, 列数) + arr(x, 3)Elsek = k + 1d(arr(x, 1)) = k棋盘(k, 1) = arr(x, 1)棋盘(k, 列数) = arr(x, 3)End IfNext xRange("f2").Resize(k, 7) = 棋盘End Sub

自定义函数

什么是自定义函数

'1 什么是自定义函数？'在VBA中有VBA函数，我们还可以调用工作表函数，我们能不能自已编写函数呢？可以，这就是本集所讲的自定义函数'2 怎么编写自定义函数？'我们可以按下面的结构编写自定义函数' Function 函数名称(参数1,参数2....)'代码'函数名称=返回的值或数组set 返回集合对象' End Function

编写和使用自定义函数
'1 取得工作表总个数的自定义函数

Function shcount()shcount = Sheets.CountEnd Function----------------------------------
Sub dd()MsgBox getv(Range("a7"))
End Sub

'2 取得单元格显示值的自定义函数

  Function getv(rg As Range)getv = rg.TextEnd Function

'3 截取字符串的函数

 Function jiequ(sr As String, fh As String, wz As Integer)Dim ArrArr = Split(sr, fh)jiequ = Arr(wz - 1)End Function-----------------------------------------------------Sub test()MsgBox jiequ("A-BRT-C-EF", "-", 2)End Sub

'4 提取不重复值的个数

  Function 不重复个数(rg As Range)Dim d, Arr, arArr = rgSet d = CreateObject("scripting.dictionary")For Each ar In Arrd(ar) = ""Next ar不重复个数 = d.CountEnd Function

参数值默认和参数缺省

Function shuiji2(maxnum, geshu, Optional qo As Integer = 2)Dim d As New DictionaryDim num, mApplication.Volatilem = 1Donum = Int(Rnd() * maxnum + 1)If qo = 2 ThenIf num Mod 2 = 0 Then d(num) = ""ElseIf qo = 1 ThenIf Not num Mod 2 = 0 Then d(num) = ""ElseExit FunctionEnd IfLoop Until d.Count = geshushuiji2 = Application.Transpose(d.Keys)
End Function