VBA新手学习笔记之:二级下拉菜单(字典嵌套法)教学内容
excel制作二级下拉菜单全过程
Excel表格制作二级下拉菜单全步骤感谢sou6 的投递时间:2011-12-15 来源:通过2级菜单,倒是可以比较深入熟悉INDIRECT, INDEX, OFFSET, 这三个函数,是你要想学excel函数,估计你肯定过的关。
在论坛里看帖子,有一点比较累,很多都是直接用excel文件里做说明,你需要下载文件。
我这里就全部用图来说明。
不过二级菜单的第一级的做法,都是相同的,大家可以参考上面的文章创建一个一级菜单。
第一种做法:使用函数INDIRECT看看例子很明显,我们希望在一级选择机房故障,那么2级就出现他下面的列表。
要实现这个目标并不复杂。
1:建立“名称3个一级选项,我们需要建立3个“名称”:机房故障线路故障用户端故障。
这个时候,你就创建了3个名称还需要建立一个名称,叫做“故障类型”这个名称包括“机房故障线路故障用户端故障”这3项。
这个时候,你就可以在“名称管理器”看到4个名称2:创建1级菜单1级菜单的办法就简单了这样就解决了一级的下拉菜单。
3:2级菜单这个地方你需要注意,=INDIRECT($F2) 如果你写成=INDIRECT($F$2),如果是这样的话,你确定会出现一个报错这个时候,你就实现了2级菜单第二种做法:使用函数INDEX还是上面的例子,用另外一种方式来实现。
这个例子里,你只需要建立2个名称。
1:建立名称建立:故障类型名称,方法和上面一样。
建立:2级名称创建上面两个名称。
2:创建下拉菜单第一下拉菜单和上面一样,我就不重复了,现在是演示第二级下拉菜单=INDEX(二级,0,match(I$2,故障类型,0))这样你就搞定2级菜单里。
第三种做法:使用函数OFFSET学这个offset函数半天,才搞定。
现在只是可以实现这个功能。
不过还有需要改进的地方还是上面的例子,=OFFSET(A2,,MATCH(L2,故障类型,)-1,6,1)这样也是可以实现2级的下拉菜单。
以上的方式其实是不太完善的,因为我们的2级菜单刚好都是6项,那么如果是不等的,那你就只能取最多的。
EXCEL VBA 常见字典用法集锦及代码详解(全)之欧阳语创编
常见字典用法集锦及代码详解前言凡是上过学校的人都使用过字典,从新华字典、成语词典,到英汉字典以及各种各样数不胜数的专业字典,字典是上学必备的、经常查阅的工具书。
有了它们,我们可以很方便的通过查找某个关键字,进而查到这个关键字的种种解释,非常快捷实用。
凡是上过EH论坛的想学习VBA里面字典用法的,几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。
我也是从这里接触到和学习到字典的,在此,对他们表示深深的谢意,同时也对很多把字典用得出神入化的高手们致敬,从他们那里我们也学到了很多,也得到了提高。
字典对象只有4个属性和6个方法,相对其它的对象要简洁得多,而且容易理解使用方便,功能强大,运行速度非常快,效率极高。
深受大家的喜爱。
本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料,希望大家能喜欢。
给代码注释估计是大家都怕做的,因为往往是出力不讨好的,稍不留神或者自己确实理解得不对,还会贻误他人。
所以下面的这些注释如果有不对或者不妥当的地方,请大家跟帖时指正批评,及时改正。
字典的简介字典(Dictionary)对象是微软Windows 脚本语言中的一个很有用的对象。
附带提一下,有名的正则表达式(RegExp)对象和能方便处理驱动器、文件夹和文件的(FileSystemObject)对象也是微软Windows 脚本语言中的一份子。
字典对象相当于一种联合数组,它是由具有唯一性的关键字(Key)和它的项(Item)联合组成。
就好像一本字典书一样,是由很多生字和对它们对应的注解所组成。
比如字典的“典”字的解释是这样的:“典”字就是具有唯一性的关键字,后面的解释就是它的项,和“典”字联合组成一对数据。
常用关键字英汉对照:Dictionary 字典Key 关键字Item 项,或者译为条目字典对象的方法有6个:Add方法、Keys 方法、Items方法、Exists方法、Remove方法、RemoveAll方法。
VBA字典典型案例学习必背代码
VBA 字典法学习与例子Sub 二列多行求和()Dim arr1, dic, x, arr2(1 To 10, 1 To 2), m%, k% '定义变量Set dic = CreateObject("Scripting.dictionary") '后期绑定引用字典arr1 = Range("A1").CurrentRegion '把单元区域装到数组arr1For x = 2 To UBound(arr1, 1) '循环数组arr1的行If dic.exists(arr1(x, 1)) Then '判断数组元素arr1(x,1)在字典关键词里是否存在,m = dic(arr1(x, 1)) '如果存在,把关键词arr1(x,1)的条目读出来,在原来的'基础上累加,通过读取关键词arr1(x,1)的条目,找到在数组arr2那一行上累加arr2(m, 2) = arr2(m, 2) + arr1(x, 2) '在数组arr2第m行,第2列上累加Else '如果关键词arr1(x,1)不存在,那么k = k + 1 '计数dic(arr1(x, 1)) = k '把数组arr1(x,1)装到字典dic里,条目装一个k,'这个k的作用来给数组arr2中找到存放那一行arr2(k, 1) = arr1(x, 1) '把数组arr1里的第x行第1列装到数组arr2的第k行,第1列arr2(k, 2) = arr1(x, 2) '把数组arr1里的第x行第2列装到数组arr2的第k行,第2列End IfNext xRange("E1:F" & Rows.Count) = "" '清空区域,用来存放新的数据[E1:F1] = Array("产品名称", "数量") '填充表头[E2].Resize(k, 2) = arr2 '把数组arr2读到单元格区域End Sub2020-8-31Sub 多列多行汇总()Dim dic, arr1, x%, MySt, k%, arr2(1 To 15, 1 To 3), y%, m%Set dic = CreateObject("Scripting.dictionary")arr1 = Range("A1").CurrentRegionFor x = 2 To UBound(arr1, 1)MySt = arr1(x, 1) & arr1(x, 2)If dic.exists(MySt) Thenm = dic(MySt)arr2(m, 3) = arr2(m, 3) + arr1(x, 3)Elsek = k + 1dic(MySt) = kFor y = 1 To 3arr2(k, y) = arr1(x, y)Next yEnd IfNext xRange("E1:G" & Rows.Count) = ""[E1:G1] = Array("产品名称", "款号", "数量")[E2].Resize(k, 3) = arr2End Sub产品名称款号数量产品名称款号数量WS-10 A 1 WS-10 A 100 WS-10 B 2 WS-10 B 2 WS-10 C 3 WS-10 C 3 VZ-45 A 1 VZ-45 A 1000 VZ-45 B 2 VZ-45 B 2 VZ-45 C 3 VZ-45 C 3 WS-10 A 99VZ-45 A 999Sub 删除重复数据-根据A列内容,保存表格内数据最上面一行,删除下面的重复行Set d = CreateObject("scripting.dictionary")Set Rng = Nothingarr = [a1].CurrentRegionApplication.ScreenUpdating = FalseFor j = 1 To UBound(arr)If d.exists(arr(j, 1)) ThenIf Rng Is Nothing ThenSet Rng = Cells(j, 1)ElseSet Rng = Union(Rng, Cells(j, 1))End IfElsed(arr(j, 1)) = ""End IfNext jIf Not Rng Is Nothing Then Rng.EntireRow.Delete Application.ScreenUpdating = TrueEnd Sub客户姓名月份消费数量A1 1 10A2 1 10A1 1 10A2 1 10A3 2 10A4 2 10A5 2 10A3 2 10A4 2 10A5 2 10A6 3 10A7 3 10A6 3 10A7 3 10A8 4 10A4 4 10A8 4 10A4 4 10A5 5 10A6 5 10A5 5 10A6 5 10A1 6 10A10 6 10A1 6 10A10 6 10A8 7 10A9 7 10A8 7 10A9 7 10Sub 根据内容查询对应数据Dim dic, arr1, arr2, arr3, arr4(1 To 100, 1 To 2), x& y& k& '定义变量Set dic = CreateObject("Scripting.Dictionary") '后期绑定引用字典Range("H2:I100") = "" '清空原有的数据arr1 = Range("A1").CurrentRegion '把区域装到数组arr1arr2 = Range("F1").CurrentRegion '把区域装到数组arr2For x = 2 To UBound(arr1, 1) '循环数组arr1的行dic(arr1(x, 1) & "|" & arr1(x, 2)) = arr1(x, 3) & "|" & arr1(x, 4)'由于两个条件,而关键字只能装一个条件,所以用&把两件条件连起来,中间用"|"分开'同理,由于有二个条目,而一个关键词只能对应一个条目,因此我也是用&连接起来,中间用"|"分开'这样就解决了多行多列装入到字典,间接地突破了字典只能装两列Next xFor y = 2 To UBound(arr2, 1) '循环数组arr2的行arr3 = VBA.Split(dic(arr2(y, 1) & "|" & arr2(y, 2)), "|")'根据arr2(y, 1) & "|" & arr2(y, 2))读字典dic里的条目出来,其实它的条目就是我们'刚才arr1后面两列的用"|"的数据,然后用函数Split切开,根据"|",赋值给数组arr3 '大家一定要明白,Split通过"|"切开,赋值给数组arr3 数组arr3是一维数组,且它的上标从0开始k = k + 1 '累加karr4(k, 1) = Val(arr3(0)) '把切开出来的数据放到数组arr4里arr4(k, 2) = Val(arr3(1))Next y[H2].Resize(k, 2) = arr4Sub 透视表示的汇总()Dim arr1, dica, dicb, x& k& y& m& n& a& b& arr2() '定义相关的变量Set dica = CreateObject("Scripting.Dictionary") '创建两个字典Set dicb = CreateObject("Scripting.Dictionary")arr1 = Range("A1").CurrentRegion '把区域装入数组arr1For x = 2 To UBound(arr1, 1) '循环数组arr1的行If Not dicb.exists(arr1(x, 2)) Then '如果关键字arr1(x,2)不存在,那么'就把它装入字典dicb里,目的就是为了去重k = k + 1 '累加k,目的给dicb做条目dicb(arr1(x, 2)) = k + 1 '这里为什么还要加1呢?原因在数组arr2里第一列是产品名称'第二放型号"大号",第三列放型号"中号",第四列放型号"小号",第五列是行汇总End IfNext xReDim arr2(1 To 100, 1 To dicb.Count + 2)For y = 2 To UBound(arr1, 1)If dica.exists(arr1(y, 1)) Then '如果字典dica里关键字arr1(y,1)存在,那么就累加arr2数据列a = dica(arr1(y, 1)) '字典dica里关键词arr1(y,1)的条目读出来,目的在是在数组arr2'里找到累加数组arr2那一行,而数组arr2有五列,具体累加到那一列呢?b = dicb(arr1(y, 2)) '字典dicb里的关键词arr1(y,2)的字典读出来,来定位到具体累加到数组arr2那一列arr2(a, b) = arr2(a, b) + arr1(y, 3)arr2(a, 5) = arr2(a, 2) + arr2(a, 3) + arr2(a, 4) '同一行三种型号相加Elsem = m + 1 '累加m,目的给dica做条目和数组arr2定位dica(arr1(y, 1)) = m '把arr1(y,1)装入字典dic2,条目为mn = dicb(arr1(y, 2))arr2(m, 1) = arr1(y, 1) '把数组arr1的第一列装入arr2里的第一列arr2(m, n) = arr1(y, 3) '把数组arr1的第三列装入arr2里的第n列End IfNext yRange("F1:J" & Rows.Count) = ""[F1] = "产品名称"[G1].Resize(1, dicb.Count) = dicb.keys[G1].Offset(0, dicb.Count) = "行总计"[F2].Resize(dica.Count, dicb.Count + 2) = arr2End Sub。
VBA字典用法
1,特殊条件编号‘2012-9-3‘/forum.php?mod=viewthread&tid=914702&page=1#pid6271907 Sub lqxs()Dim Arr, i&, j&, jj&, n&, aa, bb, y, x$Dim d As New Dictionary, k, t, d1 As New Dictionary, t1Sheet1.Activate[e31:e5000].ClearContentsArr = [a1].CurrentRegionFor i = 31 To UBound(Arr)x = Arr(i, 4)y = Arr(i, 1) & "|" & Arr(i, 3)d(x) = d(x) & i & ","If d1.Exists(x) = False Then Set d1(x) = New Dictionaryd1(x)(y) = d1(x)(y) & i & ","Nextk = d.keyst = d.itemsFor i = 0 To UBound(k)t(i) = Left(t(i), Len(t(i)) - 1)n = 0If InStr(t(i), ",") Thenaa = Split(t(i), ",")For j = 0 To UBound(aa)y = Arr(aa(j), 1) & "|" & Arr(aa(j), 3)n = n + 1t1 = d1(k(i))(y)t1 = Left(t1, Len(t1) - 1)If InStr(t1, ",") Thenbb = Split(t1, ",")For jj = 0 To UBound(bb)Cells(bb(jj), 5) = nNextj = j + UBound(bb)ElseCells(t1, 5) = nEnd IfNextEnd IfNextEnd Sub2,列表框3级数据有效性‘2012-9-4‘/thread-716135-1-1.htmlDim d1 As New DictionaryDim d2 As New DictionaryPrivate Sub ComboBox1_Click()ComboBox2.ClearComboBox3.ClearComboBox2.List = d1(ComboBox1.Text).ItemsEnd SubPrivate Sub ComboBox2_Click()ComboBox3 = ""ComboBox3.List = d2(ComboBox1.Text & ComboBox2.Text).Items End SubPrivate Sub UserForm_Initialize()arr = Sheet1.Range("a3:f" & Sheet1.[a65536].End(3).Row)For i = 1 To UBound(arr)a = arr(i, 1) & "":b = arr(i, 3) & "":c = arr(i, 6) & ""x = arr(i, 1) & arr(i, 3)If d1.Exists(a) = False Then Set d1(a) = New Dictionary d1(a)(b) = bIf d2.Exists(x) = False Then Set d2(x) = New Dictionary d2(x)(c) = cNextComboBox1.List = d1.KeysEnd Sub3,填表‘2012-9-19‘/thread-922624-1-1.htmlDim d As New DictionaryDim d1 As New DictionarySub 填充()Dim xm, rkb, rkkm, rlkm, rlxm, r, sckm, km, sSheet2.Activate[b:c].ClearContentsrkb = Sheets("任课表").Range("b2:bi16")xm = Sheets("绩效名单").Range("a2:a241")rkkm = Sheets("任课表").Range("a2:a16")For i = 1 To UBound(rkb)For j = 1 To UBound(rkb, 2)If d.exists(rkb(i, j)) = False Then Set d(rkb(i, j)) = New Dictionaryd(rkb(i, j))(rkkm(i, 1)) = rkkm(i, 1)Next jNext ik = d.Keysk1 = d(k(0)).itemsFor x = 1 To UBound(xm)If d.exists(xm(x, 1)) Thens = d(xm(x, 1)).itemsIf IsArray(s) ThenCells(x + 1, 2).Resize(1, UBound(s) + 1) = sElseCells(x + 1, 2) = sEnd IfEnd IfNextSet d = NothingEnd Sub4,2级字典嵌套‘2013-2-21‘/thread-984445-1-1.htmlSub lqxs()Dim Arr, i&, x, yDim d, k, tSet d = CreateObject("Scripting.Dictionary")Arr = [a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 1): y = Arr(i, 2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary") d(x)(y) = d(x)(y) + 1Nextk = d.keyst = d.items:For i = 2 To UBound(Arr)If d.exists(Arr(i, 1)) Then Cells(i, 3) = d(Arr(i, 1)).CountNextEnd Sub‘2013-1-22‘/thread-974297-1-1.htmlSub lqxs()Dim Arr, i&, j&, n&, ttDim d, k, t, d1, x, y, k1Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet2.ActivateArr = Sheet1.[a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 1)y = Left(Arr(i, 3), 1)d(x) = d(x) + 1If d1.Exists(x) = False Then Set d1(x) = CreateObject("Scripting.Dictionary") d1(x)(y) = d1(x)(y) + 1Nextk = d1.keyst = d1.items: n = 4: tt = 0For i = 0 To UBound(k)Cells(n, 1) = "小计"Cells(n, 2) = k(i)Cells(n, 3) = t(i).Counttt = tt + t(i).Countk1 = t(i).keysFor j = 0 To UBound(k1)n = n + 1Cells(n, 2) = k(i)Cells(n, 3) = k1(j)Cells(n, 4) = d1(k(i))(k1(j))Nextn = n + 1NextCells(3, 3) = ttEnd Sub5,3级字典嵌套‘2012-1-23‘/forum.php?mod=viewthread&tid=974963&page=2#pid6676611 Sub lqxs()Dim Arr, i&, Arr1, x$, n&, y&, Brr, r%, Brr1(), r2%, Brr2()Dim d, k, t, d1, k1, t1, k2, kk, a, b, c, cp$Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet3.Activate[a2:d50000].ClearArr1 = Sheet1.[a1].CurrentRegionArr = Sheet2.[a1].CurrentRegionFor i = 2 To UBound(Arr)a = Arr(i, 4):b = Arr(i, 3)d(b) = aNextd.RemoveAllFor i = 2 To UBound(Arr1)a = Arr1(i, 4): c = Arr1(i, 7)b = Split(Arr1(i, 3), "]")(1)cp = a & "," & bIf a <> "" ThenIf d.Exists(a) = False Then Set d(a) = CreateObject("Scripting.Dictionary")d(a)(b) = bIf d1.Exists(cp) = False ThenSet d1(cp) = CreateObject("Scripting.Dictionary")End Ifd1(cp)(c) = d1(cp)(c) + 1End IfNextk = d.keys: k1 = d1.keyst = d.items: t1 = d1.items: n = 2For i = 0 To UBound(k)k2 = t(i).keysCells(n, 1) = k(i)For j = 0 To UBound(k2)Cells(n, 2) = k2(j)x = k(i) & "," & k2(j)kk = d1(x).keysFor y = 0 To UBound(kk)If d1(x)(kk(y)) <> 0 ThenCells(n, 3) = kk(y)Cells(n, 4) = d1(x)(kk(y))n = n + 1End IfNextNextNextBrr = [a1].CurrentRegionFor i = 2 To UBound(Brr)If Brr(i, 1) <> "" Thenr = r + 1ReDim Preserve Brr1(1 To r)Brr1(r) = iEnd IfIf Brr(i, 2) <> "" Thenr2 = r2 + 1ReDim Preserve Brr2(1 To r2)Brr2(r2) = iEnd IfNextFor i = 1 To rIf i <> r Thenjs = Brr1(i + 1) - 1Elsejs = UBound(Brr)End Ifks = Brr1(i)With Cells(ks, 1).Resize(js - ks + 1).MergeEnd WithNextFor i = 1 To r2If i <> r2 Thenjs = Brr2(i + 1) - 1Elsejs = UBound(Brr)End Ifks = Brr2(i)With Cells(ks, 2).Resize(js - ks + 1).MergeEnd WithNext[a1].CurrentRegion.Borders.LineStyle = 1 End Sub6,2级字典嵌套‘2013-2-6‘/thread-980784-1-1.htmlSub lqxs()Dim Arr, i&, j&Dim d, k, t, d1, k1, t1, n&Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet2.ActivateArr = [a1].CurrentRegionFor j = 2 To UBound(Arr, 2)For i = 2 To UBound(Arr)d(Arr(1, j)) = d(Arr(1, j)) + 1If d1.Exists(Arr(1, j)) = False Then Set d1(Arr(1, j)) = CreateObject("Scripting.Dictionary")d1(Arr(1, j))(Arr(i, j)) = d1(Arr(1, j))(Arr(i, j)) + 1NextNextk = d.keys: t = d.itemsn = 40For i = 0 To UBound(k)k1 = d1(k(i)).keyst1 = d1(k(i)).itemsn = n + 1Cells(n, 1) = k(i)n = n + 1Cells(n, 1).Resize(d1(k(i)).Count, 1) = Application.Transpose(k1)Cells(n, 2).Resize(d1(k(i)).Count, 1) = Application.Transpose(t1)n = n + d1(k(i)).CountCells(n, 1) = "合计": Cells(n, 2) = t(i)NextEnd Sub7,字典的项为数组‘2013-2-8‘/thread-981240-1-1.htmlSub 数据3()Dim arrDim iRow&, i&, wbzb$'读取总表源数据wbzb = "总表"ThisWorkbook.ActivateWith Worksheets(wbzb)If Len(.[a4]) = 0 Then Exit Sub'高级筛选,去除重复值.Range("a3").CurrentRegion.AdvancedFilter xlFilterInPlace, , , TrueiRow = .Range("c" & Rows.Count).End(xlUp).RowIf iRow <= 3 Then Exit Sub '最后一行数据行低于第3行位置就退出arr = .Range("a3:j" & iRow)End With'arr2数组存储数据Dim dic As Object, arr2(), k&, j&'数据列对应关系,arrZos源列号,arrMpos目标列号Dim arrZPos, arrMPos, arrTemparrZPos = Array(4, 5, 6, 7, 8, 9, 10)arrMPos = Array(1, 2, 3, 4, 5, 10, 11)'以支行网点名字存入字典Set dic = CreateObject("Scripting.dictionary")For i = 2 To UBound(arr)If Not dic.exists(arr(i, 3)) ThenReDim arr2(1 To 11, 1 To 1)For j = LBound(arrZPos) To UBound(arrZPos)arr2(arrMPos(j), 1) = arr(i, arrZPos(j))Nextdic(arr(i, 3)) = Array(1, arr2) ' dic(arr(i, 3))(0)为存入个数,dic(arr(i, 3))(1)为数组ElsearrTemp = dic(arr(i, 3))k = arrTemp(0) + 1arr2 = arrTemp(1)ReDim Preserve arr2(1 To 11, 1 To k)For j = LBound(arrZPos) To UBound(arrZPos)arr2(arrMPos(j), k) = arr(i, arrZPos(j))Nextdic(arr(i, 3)) = Array(k, arr2)End IfNextOn Error Resume NextDim wb As WorkbookDim wbname$, Slash$wbname = "明细.xls"Slash = Application.PathSeparatorDim secAutomation As MsoAutomationSecuritySet wb = Workbooks(wbname)If Err.Number <> 0 ThenErr.ClearMsgBox ThisWorkbook.Path & Slash & wb'防止打开时运行宏secAutomation = Application.AutomationSecurityApplication.AutomationSecurity = msoAutomationSecurityForceDisableSet wb = Workbooks.Open(ThisWorkbook.Path & Slash & wbname)If Err.Number <> 0 ThenMsgBox "打开" & wb & " 出错"Err.ClearExit SubEnd IfEnd Ifwb.ActivateDim arrKey, wbZong$, keyitem, endrow2&, endrow&For Each keyitem In dic.keysWith Worksheets(keyitem)If Err.Number = 0 Then.Range("d:e").NumberFormatLocal = "@".Range("f:f").NumberFormatLocal = "G/通用格式"endrow = .Range("c" & Rows.Count).End(xlUp).Row = 3If endrow > 3 Then.Range("a4:j" & endrow).ClearContents.Range("a4:j" & endrow).Borders.LineStyle = xlNoneEnd Ifendrow = 4arr2 = WorksheetFunction.Transpose(dic(keyitem)(1))If dic(keyitem)(0) > 1 Then ‘只有1项时,赋值语句不同.Range("a" & endrow).Resize(UBound(arr2), 11) = arr2endrow2 = .Range("c" & Rows.Count).End(xlUp).Row.Range("f" & endrow).FormulaR1C1 = "=IF(COUNTIF(R4C[5]:RC11,RC[-1]&""*"")=1,""√"","""")".Range("f" & endrow & ":f" & endrow2).FillDownElse.Range("a" & endrow).Resize(1, 11) = arr2.Range("f4").FormulaR1C1 ="=IF(COUNTIF(R4C[5]:RC11,RC[-1]&""*"")=1,""√"","""")"End IfEnd IfErr.ClearEnd WithNextApplication.AutomationSecurity = msoAutomationSecurityByUIEnd Sub8,2级字典嵌套(数据有效性)‘2013-2-23‘/thread-985283-1-1.htmlPrivate Sub Worksheet_Change(ByVal Target As Range)If Target.Count > 1 Then Exit SubIf Target.Address <> "$K$2" And Target.Address <> "$M$2" Then Exit Sub Dim Arr, i&, x$, d, Brr, c%Set d = CreateObject("Scripting.Dictionary")Arr = [a1].CurrentRegionBrr = [a4].Resize(UBound(Arr) - 3, UBound(Arr, 2))For i = 5 To UBound(Arr, 2)x = Arr(1, i) & "|" & Arr(2, i)d(x) = iNextx = [k2].Value & "|" & [m2].Value[m4].Resize(UBound(Brr), 1).ClearContentsIf d.exists(x) Thenc = d(x)[m4].Resize(UBound(Brr), 1) = Application.Index(Brr, 0, c)End IfEnd SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Count > 1 Then Exit SubIf Target.Address <> "$K$2" And Target.Address <> "$M$2" Then Exit Sub Dim Arr, i&, x$, d, Brr, c%Set d = CreateObject("Scripting.Dictionary")Arr = [a1].CurrentRegionFor i = 5 To UBound(Arr, 2)x = Arr(1, i): y = Arr(2, i)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary") d(x)(y) = d(x)(y) + 1Nextk = d.keysIf Target.Address = "$K$2" ThenWith Target.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _Operator:=xlBetween, Formula1:=Join(d.keys, ",")End WithTarget.Offset(0, 2) = ""Elset = d(Target.Offset(0, -2).Value).keysWith Target.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _Operator:=xlBetween, Formula1:=Join(t, ",")End WithEnd IfEnd Sub9,列表框4级数据有效性、多条件查询‘2013-3-3‘/thread-987829-1-1.htmlDim d As New Dictionary, Arr, Brr, k, tDim d1 As New DictionaryDim d2 As New DictionaryDim d3 As New DictionaryPrivate Sub ComboBox1_Change()ComboBox2.Clear: ComboBox2 = ""ComboBox3.Clear: ComboBox3 = ""ComboBox4.Clear: ComboBox4 = ""boBox2.List = d1(boBox1.Value).itemsEnd SubPrivate Sub ComboBox2_Change()If ComboBox2 = "" Then Exit SubComboBox3.ClearComboBox4.ClearboBox3.List = d2(boBox1.Value & boBox2.Value).items End SubPrivate Sub ComboBox3_Change()If ComboBox3 = "" Then Exit SubComboBox4.ClearboBox4.List = d3(boBox1.Value & boBox2.Value & boBox3.Value).itemsEnd SubPrivate Sub CommandButton1_Click()Dim i&, x$, y$, j&, aa[b7:g5000].ClearContentsArr = Sheet1.[a1].CurrentRegionIf boBox4 <> "" Thenx = boBox1.Text & boBox2.Text & boBox3.Text & boBox4.TextFor i = 2 To UBound(Arr)y = CStr(Arr(i, 1)) & Arr(i, 6) & Arr(i, 7) & Arr(i, 8)If x = y ThenIf Arr(i, 2) <> "" Then d(Arr(i, 2)) = d(Arr(i, 2)) & i & ","End IfNextCall yyy(2)[b6] = "销售人员"ElseIf boBox3 <> "" Thenx = boBox1.Text & boBox2.Text & boBox3.TextFor i = 2 To UBound(Arr)y = CStr(Arr(i, 1)) & Arr(i, 6) & Arr(i, 7)If x = y ThenIf Arr(i, 8) <> "" Then d(Arr(i, 8)) = d(Arr(i, 8)) & i & ","End IfNextCall yyy(8)[b6] = "小组"ElseIf boBox2 <> "" Thenx = boBox1.Text & boBox2.TextFor i = 2 To UBound(Arr)y = CStr(Arr(i, 1)) & Arr(i, 6)If x = y ThenIf Arr(i, 7) <> "" Then d(Arr(i, 7)) = d(Arr(i, 7)) & i & ","End IfNextCall yyy(7)[b6] = "区域"Elsex = boBox1.TextFor i = 2 To UBound(Arr)y = CStr(Arr(i, 1))If x = y ThenIf Arr(i, 6) <> "" Then d(Arr(i, 6)) = d(Arr(i, 6)) & i & ","End IfNextCall yyy(6)[b6] = "城市"End If[b7].Resize(UBound(Brr), 6) = Brrm = [b65536].End(xlUp).Row[f7].Formula = "=rc[-2]/rc[-3]"[g7].Formula = "=rc[-2]/rc[-4]"If m > 7 Then[f7:g7].AutoFill [f7:g7].Resize(m - 6, 2)End Ifd.RemoveAll: Erase BrrEnd SubSub yyy(c)k = d.keyst = d.itemsReDim Brr(1 To d.Count, 1 To 6)For i = 0 To UBound(k)t(i) = Left(t(i), Len(t(i)) - 1)If InStr(t(i), ",") Thenaa = Split(t(i), ",")For j = 0 To UBound(aa)Brr(i + 1, 1) = Arr(aa(j), c)Brr(i + 1, 2) = Brr(i + 1, 2) + Arr(aa(j), 3)Brr(i + 1, 3) = Brr(i + 1, 3) + Arr(aa(j), 9)Brr(i + 1, 4) = Brr(i + 1, 4) + Arr(aa(j), 10)NextElseBrr(i + 1, 1) = Arr(t(i), c)Brr(i + 1, 2) = Brr(i + 1, 2) + Arr(t(i), 3)Brr(i + 1, 3) = Brr(i + 1, 3) + Arr(t(i), 9)Brr(i + 1, 4) = Brr(i + 1, 4) + Arr(t(i), 10)End IfNextEnd SubPrivate Sub Worksheet_Activate()Dim i&, xx, yy, zz, aa, bb, cp, fl, xhOn Error Resume NextArr = Sheet1.[a1].CurrentRegionFor i = 2 To UBound(Arr)xx = Arr(i, 1) & ""yy = Arr(i, 6)zz = Arr(i, 7)aa = Arr(i, 8)cp = Arr(i, 1) & Arr(i, 6)fl = Arr(i, 1) & Arr(i, 6) & Arr(i, 7)If d1.Exists(xx) = False Then Set d1(xx) = New DictionaryIf yy <> "" Then d1(xx)(yy) = yyIf d2.Exists(cp) = False Then Set d2(cp) = New DictionaryIf zz <> "" Then d2(cp)(zz) = zzIf d3.Exists(fl) = False Then Set d3(fl) = New DictionaryIf aa <> "" Then d3(fl)(aa) = aaNextboBox1.List = d1.keysEnd Sub10,3级字典嵌套‘2013-3-8‘/forum.php?mod=viewthread&tid=989716&page=1&extra=#pid676777 9Sub lqxs()Dim Arr2, Arr3, Arr4, i&, x$, y$, j&, aa, bb, cp$Dim d, k, t, k1, t1, k2, t2, k3, t3, kk, tt, jj&, s&Dim Arr33, Arr5Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet1.Activate[a2:l10].ClearContentsArr2 = Sheet2.[a1].CurrentRegionFor i = 2 To UBound(Arr2)d(Arr2(i, 1)) = d(Arr2(i, 1)) & i & ","Nextk = d.keyst = d.items: d.RemoveAllArr3 = Sheet3.[a1].CurrentRegionArr33 = Sheet3.[b1].Resize(UBound(Arr3), UBound(Arr3, 2))For i = 2 To UBound(Arr3)x = Arr3(i, 1): y = Arr3(i, 2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = d(x)(y) & i & ","Nextk1 = d.keyst1 = d.itemsArr4 = Sheet4.[a1].CurrentRegionArr5 = Sheet4.[b1].Resize(UBound(Arr4), UBound(Arr4, 2))For i = 2 To UBound(Arr4)x = Left(Arr4(i, 1), 1): y = Arr4(i, 1)cp = x & "," & yIf d1.exists(cp) = False Then Set d1(cp) = CreateObject("Scripting.Dictionary")d1(cp)(y) = d1(cp)(y) & i & ","Nextk2 = d1.keyst2 = d1.items: n = 2For i = 0 To UBound(k)t(i) = Left(t(i), Len(t(i)) - 1)Cells(n, 1).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, t(i), 0)If d.exists(k(i)) Thenkk = t1(i).keys: tt = t1(i).itemsFor j = 0 To UBound(kk)cp = k(i) & "," & kk(j)tt(j) = Left(tt(j), Len(tt(j)) - 1)Cells(n, 5).Resize(1, UBound(Arr33, 2)) = Application.Index(Arr33, tt(j), 0)If d1.exists(cp) Thenk3 = t2(j).keyst3 = t2(j).itemsFor jj = 0 To UBound(k3)t3(jj) = Left(t3(jj), Len(t3(jj)) - 1)If InStr(t3(jj), ",") Thenbb = Split(t3(jj), ",")For s = 0 To UBound(bb)Cells(n, 9).Resize(1, UBound(Arr5, 2)) = Application.Index(Arr5, bb(s), 0)n = n + 1NextElseCells(n, 9).Resize(1, UBound(Arr5, 2)) = Application.Index(Arr5, t3(jj), 0)n = n + 1End IfNextElsen = n + 1End IfNextNextEnd Sub11,2级字典嵌套汇总‘2013-3-9‘/thread-990101-1-1.htmlSub lqxs()Dim Arr, i&, x$, y$Dim d, k, d1Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet3.ActivateArr = Sheet1.[a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 5): y = Arr(i, 1)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = d(x)(y) + Arr(i, 8)Nextk = d.keysArr2 = Sheet2.[a1].CurrentRegionFor i = 2 To UBound(Arr2)x = Arr2(i, 2): y = Left(Arr2(i, 1), 7)If d1.exists(x) = False Then Set d1(x) = CreateObject("Scripting.Dictionary")d1(x)(y) = d1(x)(y) + Arr2(i, 3)Next[a2].Resize(d.Count) = Application.Transpose(k)For i = 0 To UBound(k)Cells(i + 2, 2) = d(k(i))(CStr([b1].Value))Cells(i + 2, 3) = d(k(i))(CStr([c1].Value))Cells(i + 2, 4) = Cells(i + 2, 2) + Cells(i + 2, 3) - d1(k(i))(CStr([b1].Value)) - d1(k(i))(CStr([c1].Value))NextEnd Sub12,2级字典嵌套(数据有效性)‘/thread-922132-1-1.htmlPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Count > 1 Then Exit SubIf (Target.Column <> 4 And Target.Column <> 6) Or Target.Row < 2 Then Exit Sub Dim t, Arr, dDim i&, x$, Brr, y$Set d = CreateObject("Scripting.Dictionary")Arr = Sheet10.[f1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 1): y = Arr(i, 2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = yNextIf Target.Column = 4 ThenWith Target.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _Operator:=xlBetween, Formula1:=Join(d.keys, ",")End WithTarget.Offset(0, 2) = ""Elsex = Target.Offset(0, -2).ValueIf d.exists(x) Thent = d(x).keysWith Target.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _Operator:=xlBetween, Formula1:=IIf(UBound(t) <> -1, Join(t, ","), t) End WithElseTarget = ""End IfEnd IfEnd Sub13,2级字典嵌套(成绩提取)‘2013-3-24‘/thread-995893-1-1.htmlSub lqxs()Dim Arr, i&, Arr1, x$, y$, funm$, myPath$, myName$, BrrDim d, k, t, wb As Workbook, a, b, aa, j&, zh, ps, txt$, mx1, mx2Application.ScreenUpdating = FalseSet d = CreateObject("Scripting.Dictionary")Sheet1.ActivateArr1 = [a1].CurrentRegion[a1].CurrentRegion.ClearCommentsSet wb = ThisWorkbookfunm = myPath = ThisWorkbook.Path & "\"myName = Dir(myPath & "*.xlsx")Do While myName <> "" And myName <> funmWith GetObject(myPath & myName)Arr = .Sheets(1).Range("a1").CurrentRegion.Close FalseFor i = 1 To UBound(Arr, 2)If Arr(1, i) = "学号" Then c1 = iIf Arr(1, i) = "课程名称" Then c2 = i: Exit ForNextFor i = 2 To UBound(Arr)x = Arr(i, c1): y = Arr(i, c2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = d(x)(y) & Arr(i, c2 + 1) & "," & Arr(i, c2 + 2) & "|"NextEnd WithmyName = DirLoopk = d.keys: t = d.itemsFor i = 9 To UBound(Arr1) - 1x = Arr1(i, 2)If d.exists(x) ThenFor j = 6 To UBound(Arr1, 2) Step 2y = Arr1(7, j)If d(x).exists(y) Thena = d(x)(y)a = Left(a, Len(a) - 1)If InStr(a, "|") Thenaa = Split(a, "|")mx1 = 0: mx2 = 0: txt = ""For ii = 0 To UBound(aa)txt = txt & ii + 1 & "," & aa(ii) & vbCrLfb = Split(aa(ii), ",")zh = Val(b(0)): ps = V al(b(1))If zh > mx1 Then mx1 = zhIf ps > mx2 Then mx2 = psNextCells(i, j).AddComment Text:=txtArr1(i, j) = mx1: Arr1(i, j + 1) = mx2Elseaa = Split(a, ",")Arr1(i, j) = aa(0): Arr1(i, j + 1) = aa(1)End IfEnd IfNextEnd IfNextColumns("b:b").NumberFormatLocal = "@"[a1].CurrentRegion = Arr1Application.ScreenUpdating = TrueEnd Sub14,多条件查询‘2013-5-19‘/thread-1018683-1-1.htmlSub lqxs()Dim Arr, i&, d, k, t, d1, Brr, j&, Arr1Dim x$, y, z$, a$, b$, c$Set d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet1.Activate[b5:p6].ClearContents[b5:p6].Borders.LineStyle = xlNoneArr1 = [a1].CurrentRegionArr = Sheet2.[a1].CurrentRegionFor i = 3 To UBound(Arr, 2)d1(Arr(2, i)) = iNextk1 = d1.keys[b5].Resize(1, d1.Count) = k1[b5].Resize(2, d1.Count).Borders.LineStyle = 1ReDim Brr(1 To d1.Count)For j = 3 To UBound(Arr, 2)For i = 3 To UBound(Arr)x = Arr(i, 1): z = Arr(i, 2): y = Arr(2, j)a = x & "|" & z:b = x & "|" & y:c = z & "|" & yIf d.exists(a) = False Then Set d(a) = CreateObject("Scripting.Dictionary")d(a)(y) = d(a)(y) + Arr(i, j)d(b) = d(b) + Arr(i, j)d(c) = d(c) + Arr(i, j)NextNextk = d.keys: t = d.itemsFor j = 2 To UBound(Arr1, 2)If Arr1(1, j) <> "" ThenIf Arr1(2, j) <> "" Thena = Arr1(1, j) & "|" & Arr1(2, j)For i = 0 To UBound(k1)tt = d(a)(k1(i))Brr(i + 1) = Brr(i + 1) + d(a)(k1(i))NextElseFor i = 0 To UBound(k1)b = Arr1(1, j) & "|" & k1(i)Brr(i + 1) = Brr(i + 1) + d(b)NextEnd IfElseIf Arr1(2, j) <> "" ThenFor i = 0 To UBound(k1)c = Arr1(2, j) & "|" & k1(i)Brr(i + 1) = Brr(i + 1) + d(c)NextEnd IfEnd IfNext[b6].Resize(1, d1.Count) = BrrEnd Sub15,2级字典嵌套(分表)‘/thread-1026658-1-1.html‘Split Data0613.xlsmSub lqxs()Dim Arr, i&, x$, y$, Sht As WorksheetDim d, k, t, k1, t1, Myr&, rng As RangeSet d = CreateObject("Scripting.Dictionary")Application.ScreenUpdating = FalseApplication.DisplayAlerts = FalseFor Each Sht In SheetsIf <> "Data" And <> "模板" Then Sht.Delete NextSheet1.ActivateArr = [a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 2): y = Trim(Arr(i, 3))If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")d(x)(y) = d(x)(y) + 1Nextk = d.keys: t = d.itemsFor i = 0 To UBound(k)Sheets("模板").Copy after:=Sheets(Sheets.Count)Set Sht = ActiveSheetWith Sht.Name = k(i)k1 = t(i).keyst1 = t(i).itemsSet rng = .[a31:d38].[a31] = k1(0).[d32] = t1(0)For j = 1 To UBound(k1)Myr = .[c65536].End(xlUp).Row + 1rng.Copy .Cells(Myr, 1).Cells(Myr, 1) = k1(j).Cells(Myr + 1, 4) = t1(j)NextEnd WithNextApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub16,中国式排名(D列)‘/thread-1103691-1-1.htmlSub lqxs()Dim Arr, i&, x, y$, j&, aa, Brr, Crr, cDim d, k, t, d1, k1, t1, kk, ttSet d = CreateObject("Scripting.Dictionary")Set d1 = CreateObject("Scripting.Dictionary")Sheet1.Activate[d2:e5000].ClearContentsArr = [a1].CurrentRegionFor i = 2 To UBound(Arr)x = Arr(i, 1): y = Arr(i, 2)If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary") d(x)(y) = d(x)(y) & i & ","Nextk = d.keys: t = d.itemsFor i = 0 To UBound(k)kk = t(i).keys: tt = t(i).itemsFor ii = 0 To UBound(kk)tt(ii) = Left(tt(ii), Len(tt(ii)) - 1): n = 0: n1 = 0If InStr(tt(ii), ",") Thenaa = Split(tt(ii), ",")ReDim Brr(UBound(aa))ReDim Crr(UBound(aa))For j = 0 To UBound(aa)Brr(j) = Arr(aa(j), 3)NextFor j = 0 To UBound(Brr)d1(Brr(j)) = d1(Brr(j)) & aa(j) & ","Nextk1 = d1.keys: t1 = d1.itemsd1.RemoveAllFor j = 0 To UBound(k1)t1(j) = Left(t1(j), Len(t1(j)) - 1)If InStr(t1(j), ",") Thena = Split(t1(j), ",")n = n + 1: n1 = n1 + 1For jj = 0 To UBound(a)Arr(a(jj), 4) = nArr(a(jj), 5) = n1Nextn1 = n1 + UBound(a)Elsen = n + 1Arr(t1(j), 4) = nn1 = n1 + 1Arr(t1(j), 5) = n1End IfNextElseArr(tt(ii), 4) = 1Arr(tt(ii), 5) = 1End IfNextNext[a1].CurrentRegion = ArrEnd Sub17,多级字典嵌套by:lee1892'===============================================' 字典实现的多级单元格下拉示例' By Lee1892 @ ExcelHome 2011.05.06'-----------------------------------------------' 此示例中:' Sheet1 为需要实现级联的表单' Sheet2 为存放级联内容的表单' 涉及到的事件包括:' Workbook 的Open 事件' Sheet1 的Change 事件' Sheet2 的Change 事件'-----------------------------------------------' 可以实现的功能:' 1 根据级联内容表单的内容自动生成动态级联下拉单,' 没有级联层数的限制' 2 可以随时更新级联内容,包括级联的层数和内容。
VBA新手学习笔记之:字典的定位和去重
VBA新手学习笔记之:字典的定位和去重记得前两天在出单条件汇总的笔记时,有位Joshua同学说要增加难度,希望出个多条件汇总和利用字典求解计数非重复项的内容,今天我就一次性满足ta的这两个要求:看案例,还是那个单条件汇总的案例,只是我增加了一个商品的字段,就变成了双条件的汇总了数据源:要求根据“销售部门”和“商品”分别对销量和销售额进行汇总结果:我先贴代码出来,后面再给大家收集下字典的知识下面咱们看看今天我们要学习的新内容吧:字典的去重及定位首先,字典(dictionary)不是Excel自带的对象,它是一个外部对象,所以使用之前需要引用引用方法:VBE编辑窗口——工具——引用——勾选“Microsoft Scripting Runtime”——确定就可以了;一般我们在代码中做前期绑定时,这一步骤必不可少。
引用的界面:字典的基础知识介绍:一、字典的两种绑定方式:1. 前期绑定优点:1.1:能够自动带出成员1.2:运行效率高缺点:要先引用才能用,如果代码发给没有引用字典的人,代码可能会失效。
语法见下:2. 后期绑定优点:代码的通用性较高,使用无限制,不需要引用缺点:2.1:不能自动带出成员,需要编程人员自己记住它对应的方法和属性,给编写代码增加了难度。
2.2:运行效率较前期绑定要低语法见下:二、添加数据到字典:方法1、 dic.add Keys,Items;这种方法,需要注意的是:如果添加的keys键已经存在、程序会报错,不能再对其进行添加;因为字典的keys键是不能重复的。
如下案例,Sunny已经存到字典中了,再添加时,就报错为“该关键字已经与该集合的一个元素相关联”方法2、 dic(keys)=items;这种方法较为友好,如果添加的Keys键不存在,就在字典里添加;不存在就记录(修改)最后一次存的该Keys键对应的Items值。
看以下案例,“Sunny”已经存在于字典dic中,但是用dic(“Sunny”)添加数据的方法,程序并不会报错,只是将其的Item 值由原来的“晴朗”改成了“天气晴好”第一次添加时Item为“晴朗”再次添加后,Item被修改为“天气晴好”三、访问字典的数据1. dic(key) 表示查字典,根据Key值,得到对应的item值2. dic.keys(编号) 表示根据编号查key值注意:dic.keys(编号)只用于前期绑定时有效;后期绑定的字典要根据编号得到key值的话,应该用dic.keys()(编号)来获取。
excel怎么设置下拉二级菜单
(1)
2. 第二步:进入Sheet2,选中所有数据,进入【公式】-【定义的名称】点击 【根据所选内容创建】
(1)
3. 第三步:在弹窗中将【最左列】前面方框里的勾取消掉,只保留【首行】 前面的勾。
(1)
4. 第四步:进入Sheet1工作表,选中「A3」单元格,进入「数据」-「数据 工具」-「数据验证」
(1)
5. 第五步:在「允许」中选择「序列」,在来源中,我们进入Sheet2工作 表,选择顶部所有的“省”,也就是一级分类,确定。
(1)
6. 选中「B2」单元格,进入「数据」-「数据工具」-「数据验证」,在「允 许」中选择「序列」,在来源中输入「=INDIRECT(A3)」
(1)
7. 最后,我们选择A3:B3单元格,向下填充一下。好了,来试试你的二级下 拉菜单吧
excel怎 么 设 置 下 拉 二 级 菜 单
Excel篇分享的是《excel怎么设计一级下拉框》,但是很多时侯用的比较多都 是二级下拉菜单,比如省与县这一类的用的是最多的。所以今天在分享一个二级下拉菜单怎么 做的过程。
直接上干货:
1. 第一步:准备工作,我们需要将数据存放到一个位置,这里我就放到了 Sheet2工作表中。
(完整word版)VBA字典功能
前言 (2)一、字典对象的方法 (3)(一)Add方法 (3)(二)Exists方法 (3)(三) ........................................................ Keys方法4 (四)Items方法. (5)(五)Remove方法 (5)(六) ................................................... RemoveAll方法6二、字典对象的属性. (6)(一) ....................................................... Count属性6(二) ......................................................... Key属性7(三)Item属性.. (7)(四)CompareMode属性 (8)前言凡是上过学校的人都使用过字典,从新华字典、成语词典,到英汉字典以及各种各样数不胜数的专业字典,字典是上学必备的、经常查阅的工具书。
有了它们,我们可以很方便的通过查找某个关键字,进而查到这个关键字的种种解释,非常快捷实用。
凡是上过EH论坛的想学习VBA里面字典用法的,几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码.我也是从这里接触到和学习到字典的,在此,对他们表示深深的谢意,同时也对很多把字典用得出神入化的高手们致敬,从他们那里我们也学到了很多,也得到了提高。
字典对象只有4个属性和6个方法,相对其它的对象要简洁得多,而且容易理解使用方便,功能强大,运行速度非常快,效率极高。
深受大家的喜爱.本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料,希望大家能喜欢。
给代码注释估计是大家都怕做的,因为往往是出力不讨好的,稍不留神或者自己确实理解得不对,还会贻误他人。
excel怎么制作二级联动下拉菜单
excel怎么制作二级联动下拉菜单推荐文章怎么用excel制作成条形码热度:怎么在excel表格中制作一份燃尽图表热度:在EXCEL2013表格中旋转表格的效果怎么制作热度:Excel表格中的收入和成本数据怎么制作成瀑布图热度: excel表格中怎么制作比赛自动评分表热度:日常工作中,我们常需要一个下拉菜单,让后面的下拉菜单依据前面的下拉菜单的内容的改变而改变,也就是二级联动菜单了,在excel当中该如何制作出来呢?下面就跟店铺一起看看吧。
excel制作二级联动下拉菜单的步骤1、打开excel软件,制作一个简单的个人信息表格。
2、选中单元格C2,打开“数据”菜单中的“有效性”3、进入数据有效性设置窗口,在“有效性条件”中允许下拉列表中选择“序列”。
4、选中右边的“忽略空值”与“提供下拉箭头”。
5、在“来源”下的文本框内输入供下拉选择的数据项,各个项之间以英文状态下“,”分开。
6、确定,即可在C2单元格中出现下拉箭头按钮。
拖动鼠标复制完成C列下的其他单元格,这样简单的一级下拉菜单就制作完成了。
二级联动下拉菜单1、在原来的数据基础上,我们增加一列市区,来实现省市之间的联动菜单。
2、选中单元格C2,首先我们定义一个名称,打开“插入”菜单下“名称"-"定义"3、新建一个“省份”,引用位置中选择我们在一旁创建的省市列表数据I1:J14、选择I1:J5省市的所有单元格,打开“插入”-》“名称”-》“指定”5、选择“首行”,因为我们的省份是在第一行。
6、打开“数据”菜单“有效性”,跟一级下拉菜单一样设置,在来源中输入“=省份”7、确定,即可以省份中看到下拉菜单。
8、选择单元格D2,同样打开数据有效性窗口。
9、在来源中输入:=INDIRECT($C2),根据省份来判断对应的市区。
10、确定,选择省份后就可以下拉选择所对应的市区了。
关于下拉菜单,你知道的和不知道的,都在这里了「超全收录」
关于下拉菜单,你知道的和不知道的,都在这里了「超全收录」一、下拉菜单的基础(三种制作方式)1. 数据有效性制作下拉菜单2. 表单控件之组合框制作下拉菜单3. ActiveX控件之组合框制作下拉菜单二、二级下拉菜单制作三、三级下拉菜单制作四、下拉菜单的特殊操作1. 多列数据如何设置数据有效性2. 如何制作关键字提醒的下拉菜单3. 如何制作越选越少的下拉菜单五、Word中下拉菜单的制作下拉菜单的基础一、数据有效性制作下拉菜单依次找到【数据】→【数据有效性】→【数据有效性(V)…】 → 【设置】序列 → 【设置】来源数据有效性制作下拉菜单来源有以下四种:①直接引用单元格区域(限制其仅能引用同一工作表中同一列或者同一行的连续区域);②引用公式(公式必须是引用某个连续的列(行)区域,支持数组,但不支持内存数组);③使用定义名称(就是把第②项的公式定义成名称,然后引用这个名称,可实现跨表引用数据);④直接输入序列(例如:输入『1,2,3,4,5,6,7』,注:此处只能使用半角逗号分隔,区分大小写)。
小技巧:在直接输入序列的时候,如何在下拉列表中做一个空格选项呢?如果是手动输入序列来源,则用全角状态下的空格;如果是用公式,公式引用的时候多引用一行空白内容即可。
下拉列表中增加空白选项二、表单控件之组合框制作下拉菜单依次找到【开发工具】→【插入】→【表单控件】→【组合框】→工作表中画一个组合框 → 设置控件格式 → 【控制】数据来源区域 → 【控制】单元格链接【控制】下拉显示项数表单控件制作下拉菜单注意:使用表单控件的组合框,选择菜单中的某一项后,单元格中得到的内容并非所选择的内容,而是所选择的内容在数据列中所处的位置。
(此法常用于制作动态的图表)三、ActiveX控件之组合框制作下拉菜单依次找到【开发工具】→【插入】→【ActiveX控件】→【组合框】 → 工作表中画一个组合框 → 右键选择【属性】 →【ListFillRange】数据来源区域 → 【LinkedCell |】单元格链接 → 【ListRows】下拉显示项数 → 退出设计模式ActiveX控件制作下拉菜单用ActiveX控件制作简单的下拉菜单,还可以设置其他的属性,比图控件的大小、位置、风格、字体、颜色等。
Excel使用技巧—制作炫酷的多级下拉菜单原来这么简单
Excel使用技巧—制作炫酷的多级下拉菜单原来这么简单
今天,我们学习的是Excel的比较炫酷的功能—制作多级下拉菜单。
下拉菜单的好处就是提供了输入的选项,不用手动输入,只需选择一项即可。
平时我们经常看到下拉菜单里一个选项改变,另一个下拉菜单的内容会跟着改变,是不是觉得很酷?不用羡慕,本文将手把手教你如何制作一个多级下拉菜单。
1.一级下拉菜单
一级下拉菜单应用最多的就是性别,下拉选项为男女二项,省的手动输入。
数据-有效性-序列-输入'男,女'或引用单元格的内容都行。
GIF
GIF
2.二级下拉菜单
如图将省份放在首行,市放在省下面。
选中省市名称(不要选择空白单元格,不然,也会被添加进入菜单中的)。
选好后选择公式-定义名称-根据所选内容创建,只勾选首行,然后确定。
省份的设置就是一级下拉菜单。
市级的设置在数据有效性-序列的来源需要输入=INDIRECT(A8),A8即省份所在单元格,最后下拉将刚才设置好的格式填充到下面单元格即可。
动态操作如下:
GIF
3.三级下拉菜单
省市放在一起时省要放在首行或首列,市县放在一起时市要放在首行或首列,这是为了在创建名称时能够根据首行或首列来创建。
具体动态操作如下:
GIF
GIF
好了,本次分享的就是Excel中一二三级下拉菜单的制作方法,如果大家还有什么不懂的可以在下方留言,欢迎观看!。
VBA嵌套字典的递归输出(序列化)
VBA嵌套字典的递归输出(序列化)6VBA嵌套字典的递归输出(序列化)作者:AntoniotheFuture关键词:VBA,字典,Dictionary,嵌套,递归,序列化开发平台:VBE平台版本上限:未知平台版本下限:未知开发语言:VBA简介:用递归的方法将一个VBA的嵌套字典对象全部输出到文本框内。
最近笔者的工作中使用到了VBA的Dictionary(字典)对象,这种对象是一种键值对对象,表现形式为:key:item ,其中Key是不可重复的,item也可以为另外一个字典,多个字典嵌套所形成的对象可以让我很方便地操作一个类,我在这一个对象内完成大部分的动作,极大地简化了我的代码。
要创建这样的对象,只需要像下面这样做就行了:1.Dim AllDic as object2.Dim PeopleDic as object3.Dim HousesDic as object4.Dim HouseDic as object5.Dim RommDic as object6.set AllDic = CreateObject('Scripting.Dictionary')7.set PeopleDic = CreateObject('Scripting.Dictionary')8.set HousesDic = CreateObject('Scripting.Dictionary')9.set HouseDic = CreateObject('Scripting.Dictionary')10.set RommDic = CreateObject('Scripting.Dictionary')11.12.RommDic.add 1,'客厅'13.RommDic.add 2,'主卧'15.HouseDic.add 'Addr','中山路3号'16.HouseDic.add 'Price','120万'17.HouseDic.add 'Rooms',RommDic18.19.HousesDic.add 1,HouseDic20.21.RommDic.removeall22.HouseDic.removeall23.24.RommDic.add 1,'客厅'25.RommDic.add 2,'主卧'26.RommDic.add 3,'阳台'27.HouseDic.add 'Addr','西安路58号'28.HouseDic.add 'Price','90万'29.HouseDic.add 'Rooms',RommDic30.HousesDic.add 2,HouseDic31.32.PeopleDic.add 'Name','王明'33.PeopleDic.add 'BirthDate','1990-01-01'34.PeopleDic.add 'Horses',HousesDic35.36.AllDic.add 1,PeopleDic37.38.RommDic.removeall39.HouseDic.removeall40.HousesDic.removeall41.PeopleDic.removeall42.43.RommDic.add 1,'客厅'45.RommDic.add 3,'次卧1'46.HouseDic.add 'Addr','北京路159号'47.HouseDic.add 'Price','145万'48.HouseDic.add 'Rooms',RommDic49.HousesDic.add 1,HouseDic50.PeopleDic.add 'Name','李红'51.PeopleDic.add 'BirthDate','1980-10-01'52.PeopleDic.add 'Horses',HousesDic53.54.AllDic.add 2,PeopleDic这样我们创建了AllDic这样一个嵌套的字典,他的实际内容是这样的:1.AllDic:2.1::'王明'4.BirthDate:'1990-01-01'5.Horses:6.1:7.Addr:'中山路3号'8.Price:'120万'9.Rooms:10.1:'客厅'11.2:'主卧'12.3,'厨房'13.2:14.Addr:'西安路58号'15.Price:'90万'16.Rooms:17.1:'客厅'18.2:'主卧'19.3,'阳台'20.2::'李红'22.BirthDate:'1980-10-01'23.Horses:24.1:25.Addr:'北京路159号'26.Price:'145万'27.Rooms:28.1:'客厅'29.2:'主卧'30.3,'次卧1'31.32.33.34.35.这是一个四层的字典,第二层是人,第三层是房子,第四层是房间,需要引用里面的信息时,只需要像这样就行了:第一个人第二套房子的地址:AllDic(1)('Horses')(2)('Addr')第二个人的生日:AllDic(2)('BirthDate')这种结构是不是似曾相识呢?对的,他就像Json。
VBA新手学习笔记之:二级下拉菜单(字典嵌套法)教学内容
V B A新手学习笔记之:二级下拉菜单(字典嵌套法)VBA新手学习笔记之:二级下拉菜单(字典嵌套法)如下效果图:今天这个效果所涉及的新增知识点有:1. 模块级变量的定义2. 事件程序3. 字典嵌套4. Join函数下面我们逐一来解读下这四个知识点:1.先看看什么是事件之前我们执行Excel程序都需要手动画一个按钮,然后将对应的过程指定给这个按钮,当我们需要程序运行的时候,就发送一个命令(点一下按钮)给这个程序,程序接收命令后,会按照程序的逻辑进行运行。
而事件程序是不需要手工指定按钮,而是当我们在操作Excel的时候有些动作会自动被ExcelVBA所识别,VBA内部已经自行内置了有关此事件的过程名,我们在对应的过程中写需要执行操作的代码,当Excel的某个动作发生的时候,会自动触发执行所写的程序。
这个案例所用到的事件程序有两个:第一:单元格选区发生变化的时候:当需要填写省份的那一列的单元格选区发生变化时,需要添加去重后的省份的下拉菜单操作方法:对准需要达到效果的工作表名的位置右键——查看代码——进入工作表的代码编辑区——选择worksheet——会自动弹出(单元格选区发生变化时要执行的过程)——在该过程中写所需要的代码即可Private SubWorksheet_SelectionChange(ByVal Target As Range)End Sub第二:单元格的值发生变化的时候:当省份填写完毕后,则需要将对应省份的城市添加到城市单元格的下拉菜单,如果省份单元格没有填、则城市下拉菜单跟着消失。
操作方法:前面的操作与第一点都是一样的,调出代码窗口后——选择worksheet——在事件下拉框中选择Change事件——会自动生成(单元格值发生变化时要执行的过程)Private Sub Worksheet_Change(ByValTarget As Range)End Sub2.因为今天的两个程序中都需要使用同一个字典来做数据有效性的下拉菜单,所以用了一个字典对象的模块级变量dicSF,所谓模块级变量即在同一个模块内所有程序都能使用的变量;这里涉及到变量的作用域的问题,大家可以百度搜索下什么叫变量的作用域。
Excel之VBA常用功能应用篇:Excel下拉列表的操作方法
Excel之VBA常用功能应用篇:Excel下拉列表的操作方法本节介绍一下ControlFormat对象,严格来说这个对象是对应于Excel中的ListBox对象的一些属性和方法,为什么不以ListBox来返回,就不太清楚了。
总之,要对Excel表中的ListBox对象操作就这么做就行了。
那么,如何得到ControlFormat对象呢?用下面的方法:dim xCF as ObjectSet xCF=Shapes(i).ControlsFormat对象xCF就是一个ControlFormat对象,其中i代表了此Shape 的Index值。
这就有点不可想象了,Shape是Excel表绘图层中的对象,例如自选图形、任意多边形、OLE 对象或图片,此处就代表了一个OLE对象,即ListBox。
有点乱,但要了解一下Shape对象,如下图所示,有按钮对象,下拉列表和文本框对象,都属于Shapes对象合集。
可以使用Shape对象的ContrlFormat来返回ContrlFormat对象。
当我们得到这个ContrlFormat对象之后,就可以对下拉列表框进行各种添加删除操作了。
ContrlFormat对象有四个方法:Additem、List、RemoveAllitems、Removeitem懂基本英语就基本明白这四种方法的功能了,这里不做过多介绍,具体可参考下面的代码进行对号。
更加重要的是ContrlFormat的属性,一共有17个,属性就是用一些固定的参数来进行设置,可以使下拉列表框更加符合要求,目的很简单。
下面,用实例来证明一下我们通过代码如何实现对下拉列表的添加、修改、删除等等操作。
添加列表框Private Sub AddListBox()DelListbox '删除除列表框Dim xlobj As Object'添加列表框Set xlobj =Me.Shapes.AddFormControl(xlListBox,Range("E3").Left, Range("E3").T op, 200,350)Dim xFormat As ObjectSet xFormat = xlobj.ControlFormat '返回列表对象xFormat.RemoveAllItems '清除列表内容xFormat.ListFillRange =Range("C4:C20").Address'设置列表区域Set xFormat = NothingSet xlobj = NothingEnd Sub返回列表值Private Sub ShowListValue()Dim xShape As ShapeFor Each xShape In Me.ShapesIf xShape.Type = 8 ThenMsgBoxxShape.ControlFormat.List(xShape.ControlFormat.ListIndex)End IfNext xShapeEnd Sub给列表框添加列表Private Sub AddListItems()Dim xShape As ShapeFor Each xShape In Me.Shapes'遍历ShapesIf xShape.Type = 8 Then'如果是列表xShape.ControlFormat.RemoveAllItems'清除所有列表值For i = 4 To 7xShape.ControlFormat.AddItemRange("B" & i).Value'添加列表Next iEnd IfNext xShapeEnd Sub如上代码,根据ContrlFormat的四个方法和属性可实现所有对列表框的添加删除修改功能。
EXCEL VBA 常见字典用法集锦及代码详解(全)之欧阳科创编
常见字典用法集锦及代码详解前言凡是上过学校的人都使用过字典,从新华字典、成语词典,到英汉字典以及各种各样数不胜数的专业字典,字典是上学必备的、经常查阅的工具书。
有了它们,我们可以很方便的通过查找某个关键字,进而查到这个关键字的种种解释,非常快捷实用。
凡是上过EH论坛的想学习VBA里面字典用法的,几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。
我也是从这里接触到和学习到字典的,在此,对他们表示深深的谢意,同时也对很多把字典用得出神入化的高手们致敬,从他们那里我们也学到了很多,也得到了提高。
字典对象只有4个属性和6个方法,相对其它的对象要简洁得多,而且容易理解使用方便,功能强大,运行速度非常快,效率极高。
深受大家的喜爱。
本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料,希望大家能喜欢。
给代码注释估计是大家都怕做的,因为往往是出力不讨好的,稍不留神或者自己确实理解得不对,还会贻误他人。
所以下面的这些注释如果有不对或者不妥当的地方,请大家跟帖时指正批评,及时改正。
字典的简介字典(Dictionary)对象是微软Windows脚本语言中的一个很有用的对象。
附带提一下,有名的正则表达式(RegExp)对象和能方便处理驱动器、文件夹和文件的(FileSystemObject)对象也是微软Windows脚本语言中的一份子。
字典对象相当于一种联合数组,它是由具有唯一性的关键字(Key)和它的项(Item)联合组成。
就好像一本字典书一样,是由很多生字和对它们对应的注解所组成。
比如字典的“典”字的解释是这样的:“典”字就是具有唯一性的关键字,后面的解释就是它的项,和“典”字联合组成一对数据。
常用关键字英汉对照:Dictionary 字典Key 关键字Item 项,或者译为条目字典对象的方法有6个:Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。
Excel初学者对于VBA字典法的理解
Excel初学者对于VBA字典法的理解本帖最后由 f8b1987 于 2012-6-8 12:34 编辑引用: 在引用工作表名称把单元格写入数组的话,定义数组不要使用dim arr()这种形式,使用dim arr即可。
接触了VBA字典法一段时间,虽然没有什么大的提升,总算对字典法有个初步的理解。
想当初,刚学的时候,可是问了很多幼稚的问题{:soso_e106:}。
对于字典法的含义解释,当然有EH VBA版主蓝桥玄霜的帖子:版主的帖子说得挺不错的。
但是,对于像我这种VBA学习水平不高且初学字典法的人,有很多地方还是有点难理解的。
在这里,我只作为一个菜鸟的理解,用菜鸟的语言对字典法进行基础解释。
我们看下面的代码:1.Sub 字典简要解释()2.Dim i As Integer, j As Integer, dic As Object, arr, brr3.'定义i、j,定义字典对象dic,定义动态数组arr、brr4.5.Set dic = CreateObject('scripting.dictionary')6.'固定用法,意为创建字典对象,这里的dic是变量,并非要求用dic。
7.brr = Sheet2.Range('a1').CurrentRegion8.'单元格区域装入数组,查看范围可以选择A1单元格,按下CTRL+*即可选定该范围9.arr = Sheet1.Range('a1').CurrentRegion10.11.12.For i = 2 To UBound(brr)13.dic(brr(i, 1)) = brr(i, 2)14.'字典(KEY)=item,意思是把brr(i,1)的值循环写入字典的key,并把brr(i,2)作为字典的item15.'dic锁的集合体,有很多锁。
好比是:锁头(钥匙)=打开锁的车子16.17.'Key = brr(i, 1)18.19.'理论上一条不同的钥匙只能打开一把锁,你能打开宝马的锁还是打开摩托车的锁,就取决于你的钥匙。
ExcelVBA字典实现窗体二级下拉菜单
ExcelVBA字典实现窗体二级下拉菜单ExcelVBA字典实现窗体二级下拉菜单问题提出:选择确定ComboBox1中的数值后,ComboBox2的下拉列表自动引用ComboBox1中数值对应的列的内容。
如何能做到我现在想在加一重判断:就是判断ComboBox2中的数值,如果是原来ComboBox1对应列中已有的值,就直接向下进行,如果原来ComboBox1对应列中没有该值,自动添加到该列最下一个非空行之后再向下执行。
字典的引用:窗体代码如下:Public Arr, Dic As NewDictionary'声明为公共变量,引用“Microsoft Scripting Runtime”Private Sub UserForm_Initialize() '窗体初始化事件DimBrrArr =Sheet1.Range("A1").CurrentRegion.Value 'A1单元格已用区域For i = 1 ToUBound(Arr,2)'循环标题,并添加到字典If Not Dic.Exists(Arr(1, i))Then'字典中不存在关键字Dic.Add Arr(1, i), Dic.Count +1'添加关键字,Item为索引End IfNextBrr =Dic.KeysboBox1.Clear'清除列表框1条目For i = 0 ToUBound(Brr) -1'列表框1添加条目boBox1.AddItem Brr(i) NextEnd SubPrivate Sub ComboBox1_DropButtonClick() '列表框1下拉事件DimBrrIfboBox1.Text = "" Then ExitSub'如果列表框1为空,就退出过程boBox2.Clear'清空列表框2条目IfDic.Exists(boBox1.Text) Then '如果列表框的关键字,在字典中有记录Brr = Application.WorksheetFunction.Index(Arr, 0,Dic(boBox1.Text)) '用Index函数取出整列数据For i = 2 To UBound(Brr,1)'列表框2添加条目boBox2.AddItem Brr(i,1)'列表框2添加条目NextEnd IfEnd SubPrivate Sub CommandButton1_Click() '按钮1单击事件IfboBox1.Text = "" Or boBox2.Text = ""Then ExitSub'如果列表框1,2为空,就退出过程Dim Brr,CrrBrr =Application.WorksheetFunction.Index(Arr, 0,Dic(boBox1.Text))'用Index函数取出整列数据Crr =VBA.Filter(Application.Transpose(Brr),boBox2.Text,True)'取出匹配列表框2的值IfUBound(Crr) = -1 Then'如果有列表框2的值,数组不会为-1,'如果列表框2中没有此关键字,往原数据添加此关键字Sheet1.Cells(Rows.Count,Dic(boBox1.Text)).End(xlUp).Offset(1).Value = boBox2.TextEnd IfSheet1.Cells(Rows.Count, 10).End(xlUp).Offset(1).Value =boBox2.Text'+ boBox1.Text '把数据写入单元格boBox1.Text = "": boBox2.Text = ""'列表框1,2显示为空白boBox1.Clear:boBox2.Clear'清空列表框1,2的条目CallUserForm_Initialize'初始化窗体,为下一次录入数据准备End Sub效果图:更多分享请关注微信号微信号:Excel335081548 或: 雪山飞狐Excel 喜欢本文,请点击右上角,分享本文。
excelvba常见字典用法集锦及代码详解
常见字典用法集锦及代码详解前言凡是上过学校的人都使用过字典,从新华字典、成语词典,到英汉字典以及各种各样数不胜数的专业字典,字典是上学必备的、经常查阅的工具书。
有了它们,我们可以很方便的通过查找某个关键字,进而查到这个关键字的种种解释,非常快捷实用。
凡是上过EH论坛的想学习VBA里面字典用法的,几乎都看过研究过northwolves 狼版主、oobird版主的有关字典的精华贴和经典代码。
我也是从这里接触到和学习到字典的,在此,对他们表示深深的谢意,同时也对很多把字典用得出神入化的高手们致敬,从他们那里我们也学到了很多,也得到了提高。
字典对象只有4个属性和6个方法,相对其它的对象要简洁得多,而且容易理解使用方便,功能强大,运行速度非常快,效率极高。
深受大家的喜爱。
本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料,希望大家能喜欢。
给代码注释估计是大家都怕做的,因为往往是出力不讨好的,稍不留神或者自己确实理解得不对,还会贻误他人。
所以下面的这些注释如果有不对或者不妥当的地方,请大家跟帖时指正批评,及时改正。
字典的简介字典(Dictionary)对象是微软Windows脚本语言中的一个很有用的对象。
附带提一下,有名的正则表达式(RegExp)对象和能方便处理驱动器、文件夹和文件的(FileSystemObject)对象也是微软Windows脚本语言中的一份子。
字典对象相当于一种联合数组,它是由具有唯一性的关键字(Key)和它的项(Item)联合组成。
就好像一本字典书一样,是由很多生字和对它们对应的注解所组成。
比如字典的“典”字的解释是这样的:“典”字就是具有唯一性的关键字,后面的解释就是它的项,和“典”字联合组成一对数据。
常用关键字英汉对照:Dictionary 字典Key 关键字Item 项,或者译为条目字典对象的方法有6个:Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。
VBA字典用法小记
VBA字典用法小记编辑整理:尊敬的读者朋友们:这里是精品文档编辑中心,本文档内容是由我和我的同事精心编辑整理后发布的,发布之前我们对文中内容进行仔细校对,但是难免会有疏漏的地方,但是任然希望(VBA字典用法小记)的内容能够给您的工作和学习带来便利。
同时也真诚的希望收到您的建议和反馈,这将是我们进步的源泉,前进的动力。
本文可编辑可修改,如果觉得对您有帮助请收藏以便随时查阅,最后祝您生活愉快业绩进步,以下为VBA字典用法小记的全部内容。
VBA字典用法小记十分鄙视那些将蓝桥玄霜大大的成果上传后还要收取下载券的做法,本来想直接上传一份大大的原版,可是百度文档提示已经有重复的文档,没办法,只好自己修改一下,在上传,想无私奉献的大大致敬!!!!!!!!!!常用语句:Dim dSet d = CreateObject("Scripting。
Dictionary”)d.Add ”a","Athens”d.Add "b", "Belgrade"d。
Add "c",”Cairo"代码详解1、Dim d :创建变量,也称为声明变量。
变量d声明为可变型数据类型(Variant),d 后面没有写数据类型,默认就是可变型数据类型(Variant)。
也有写成Dim d As Object的,声明为对象。
2、Set d = CreateObject(”Scripting。
Dictionary”):创建字典对象,并把字典对象赋给变量 d.这是最常用的一句代码。
所谓的“后期绑定”。
用了这句代码就不用先引用c:\windows\system32\scrrun。
dll了.3、d.Add "a", ”Athens":添加一关键字”a"和对应于它的项”Athens”。
4、d.Add "b", “Belgrade":添加一关键字”b”和对应于它的项”Belgrade”。
- 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
VBA 新手学习笔
记
之:二级下拉菜单
(字
典嵌套法)
VBA新手学习笔记之:二级下拉菜单(字典嵌套法)
如下效果图:
今天这个效果所涉及的新增知识点有: 1.模块级变量的定
义2.事件程序3.字典嵌套4. Join函数
下面我们逐一来解读下这四个知识点:
1.先看看什么是事件之前我们执行Excel程序都需要手
动画一个按钮,然后将对应的过程指定给这个按钮,当我们需要程序运行的时候,就发送一个命令(点一下按钮)给这个程序,程序接收命令后,会按照程序的逻辑进行运行。
而事件程序是不需要手工指定按钮,而是当我们在操作
Excel的时候有些动作会自动被ExcelVBA所识别,VBA内部已经自行内置了有关此事件的过程名,我们在对应的过程中写需要执行操作的代码,当Excel的某个动作发生的时
候,会自动触发执行所写的程序。
这个案例所用到的事件程序有两个:第一:单元格选区发生变化的时候:当需要填写省份的那一列的单元格选区发生变化时,需要添加去重后的省份的下拉菜单操作方法:对准需要达到效果的工作表名的位置右键一一查看代码一—进入工作表的代码编辑区选择worksheet --------------------------- 会自动弹出(单元格选区发生变化时要执行的过程)——在该过
程中写所需要的代码即可
Private SubWorksheet_SelectionChange(ByVal Target As Range)
End Sub
第二:单元格的值发生变化的时候:当省份填写完毕后,
则需要将对应省份的城市添加到城市单元格的下拉菜单,如果省份单元格没有填、则城市下拉菜单跟着消失。
操作方法:前面的操作与第一点都是一样的,调出代码窗
口后 -- 选择worksheet ------ 在事件下拉框中选择Change事
件 --- 会自动生成(单元格值发生变化时要执行的过程)
Private Sub Worksheet_Change(ByValTarget As Range) End Sub 2.因为今天的两个程序中都需要使用同一个字典来做数据有
效性的下拉菜单,所以用了一个字典对象的模块级变量
dicSF,所谓模块级变量即在同一个模块内所有程序都能使用
的变量;这里涉及到变量的作用域的问题,大家可以百度搜索下什么叫变量的作用域。
3•字典嵌套的运用,因为我们要通过不同的省份分别对应找到其对应的城市,显然这是一个字典无法完成的事情,因为我们有很多个省份,多个省份下又又多个城市,所以我们在省份字典dicSF中每存入一个省份,那么就将这个省份
作为一个新的字典的名称再创建一个字典,在这个字典下将城市再
存入省份这个字典的Keys里字典嵌套大家不要想
得太复杂,我们只要将省份字典的keys看成是你定义的一
个新的字典名称,就很容易理解了就拿案例来说:字典嵌套的核心代码见下For i = 2 To UBound(arr) If Not dicSF.Exists(arr(i,1)) Then '创建对应省份的字典Set dicSF(arr(i, 1)) =CreateObject('scripting.dictionary') End If ' 在该省份的字典内添加所属城市dicSF(arr(i,1))(arr(i, 2))=
''Next i代码解读:如果字典dicSF中没有对应的省份,比如现在I 循环到2,那么省份就是云南,第一个循环,云南还没有存到dicSF 中,那么NotdicSF.Exists(arr(i, 1))的结果就是True,就执行下面的这个创建字典的操作Set dicSF(arr(i, 1)) =CreateObject('scripting.dictionary'),我们把代码分解出来,dicSF是我们定义的一个字典名称;同理:Set dicSF(arr(i, 1))也可以看成我们定义的一个字典的名称,如果i=2,那么这里的
dicSF(arr(i, 1))实际上就是dicSF (云南),那么在这个字典里添加对应城市的代码dicSF(arr(i, 1))(arr(i, 2))=''就可以看成dicSF (云南)(思茅市)=“”,也就是说“思茅市” 是dicSF (云南)的第一个key。
循环完之后,所有的省份就都创建了一个字典并将其下属的城市都存进其keys中了。
4.join函数是将一个数组以给定的分割符组合成一个长字符串,数据有效性种序列来源值的格式要求将每个城市以逗号分割开,我们知道,字典的keys和Items都是一个以0开始的一维数组,在选择来
源的时候我们不能直接将数组给它,所以就用到Join函数来连接数组的每个元素了。
With Target.Validation .Delete .AddType:=xlValidateList,AI
ertStyle:=xlValidAlertStop,Operator:=_
xlBetween, Formula1:=Join(dicSF.Keys, ',')End With
最后附上两段完整的代码:Option Explicit '要求变量声明
Dim dicSF As Object '定义一个模块级变量用来存去重之后的省份'单元格的值发生变化时要做的事Private Sub
Worksheet_Change(ByVal Target As Range) Dim strSF As String With Target If .Column & It ;& gt; 6 Then Exit Sub If .Count & It; >
1 Then Exit Sub strSF = .Value
'下面是通过'数据有效性’录制宏得到的代码
With .Offset© ".Validation .Delete If strSF
& It ;> ” Then .Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(dicSF(strSF).Keys, ',')
Else .Add Type:=xlValidateInputOnly,
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween End If End With End
WithEnd Sub
'单元格选区发生变化时要做的事Private Sub
Worksheet_SelectionChange(ByVal Target As Range) Dim arr, i As Integer If Target.Column <& gt; 6 Then Exit Sub If Target.Row
> 1 Then '清空选中单元格对应城市的单元格的内容
Target.Offset(0, 1).Value = ” Set dicSF
=CreateObject('scripting.dictionary') arr =
Range('A1').CurrentRegion.Value For i = 2 To UBound(arr) '如果字典里没有保存该省份If Not dicSF.Exists(arr(i, 1)) Then '创建对应省份的字典Set
dicSF(arr(i, 1)) = CreateObject('scripting.dictionary') End
If '在该省份的字典内添加所属城市dicSF(arr(i, 1))(arr(i, 2)) = '' Next i '添加数据有效性With Target.Validation .Delete .Add
Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operators _ xlBetween, Formula1:=Join(dicSF.Keys, ',') End With End IfEnd Sub 好了,今天分享完毕,各位早点休息。