常见字典用法集锦及代码详解

蓝桥玄霜

原帖由 yvhgydn 于 2010-10-22 23:14 发表
Sub 余1余5()  'by:狼版主
Dim dic As Object, i As Long, arr
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 1000
dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "", "@"), ""
Next
arr = Workshee ...

Filter的第3个参数设置为0的时候，代码运行是可以的，但是答案不符合要求了。得到的是2、3、4、6....

zxd1205

好东西  收藏学习

李巴

原帖由 蓝桥玄霜 于 2010-10-22 20:38 发表

这里是只要有关键字出现一次，它对应的项就加1。就象普通变量m=m+1一样的意思。

为什么不重复的最后并没显示出来，是咋控制的呢。
---------------------------------------------------
1也有的，我看了，但是如果只显示重复的，不显示唯一的又如何控制呢

[ 本帖最后由 李巴 于 2010-10-23 13:09 编辑 ]

lym321

感谢
楼主
对网友
热情细心指导


现
本菜
珍藏了
狼版多年前的字典+数组代码

由于
基础差
直至今日
还是
如法弄懂（不太明白的代码部份是： Else  后面的循环语句）
故
请指点一下

Sub AAA()
Dim n As Long
Dim A As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim arr
Dim arr2()
Dim s
Dim temp As String
Dim d As Object

Application.ScreenUpdating = False

n = Sheet1.[a65536].End(xlUp).Row - 1 '原始数据行数
arr = Sheet1.[A2].Resize(n, 27) '赋值给数组arr
ReDim arr2(1 To n, 1 To 27)
s = Array(18, 19, 20, 21, 22, 23, 27) '汇总字段
Set d = CreateObject("scripting.dictionary") '创建字典

For i = 1 To n
    temp = arr(i, 9) & vbTab & arr(i, 10) & vbTab & arr(i, 15) & vbTab & arr(i, 17) & vbTab & arr(i, 26) '汇总的根据字段
   
    If Not d.exists(temp) Then '如果尚无记录
        k = k + 1 '新数组行索引加1
        d.Add temp, k
        For A = 1 To 27 '整行复制
        arr2(k, A) = arr(i, A)
        Next
   
   Else

       For j = 0 To UBound(s) '累计汇总字段
       arr2(d(temp), s(j)) = arr2(d(temp), s(j)) + arr(i, s(j))
       Next
  End If
  Next
Set d = Nothing '释放字典对象
Sheet2.[b:b,n:n,p:p].NumberFormatLocal = "@"
Sheet2.[A1].Resize(n, 27) = arr2 '新的数据表格式放于sheet2
Application.ScreenUpdating = True '允许刷屏
MsgBox "ok"
End Sub


疑问1:If-----Then------Else 选择语句解释

    本菜是这样理解的：If（如果明天，天空下雨）The
                      本菜不会去郊游
                     
                      Else（反之）
                      本菜就去郊游
    由上面得知：
                     本菜不会去郊游

                     和

                     本菜就去郊游
                     是两上独立的，无关连的语句
                     因而
   无法理解狼版实例代码 Else后面的循环语句----数组arr2 怎么能 上下关联？？？？？


疑问2：（也是： Else  后面的循环语句）
        是怎样来累加求和的
        能否分析解释一下代码


谢谢！！！！

蓝桥玄霜

上面的条件是：如果字典d中不存在temp这个关键字，那么把关键字temp和对应的项k值加入字典；如果已经有了这个关键字，那么执行Else下面的语句；
For j = 0 To UBound(s) '累计汇总字段，有7个字段要累计的，所以执行一个循环
arr2(d(temp), s(j)) = arr2(d(temp), s(j)) + arr(i, s(j))
其中d(temp)是关键字对应的项k的值，s(j)是要汇总的列的值，依次＝18，19, 20, 21, 22, 23, 27
arr2(d(temp), s(j)) 的第一次值在上面的For A = 1 To 27 这个循环中逐一赋值了，
所以加上arr(i, s(j))就是累计的数据了。

蓝桥玄霜

原帖由 李巴 于 2010-10-23 12:49 发表

为什么不重复的最后并没显示出来，是咋控制的呢。
---------------------------------------------------
1也有的，我看了，但是如果只显示重复的，不显示唯一的又如何控制呢

本例显示的结果是有重复的（个数>1）也有唯一的（个数＝1）。楼主说的“不显示唯一的”？是只要显示个数>1的？
如果是这个要求：可在赋值给单元格之前增加一个判断，使个数>1的另外赋给一个新的数组即可。

lym321

原帖由 蓝桥玄霜 于 2010-10-23 21:14 发表
上面的条件是：如果字典d中不存在temp这个关键字，那么把关键字temp和对应的项k值加入字典；如果已经有了这个关键字，那么执行Else下面的语句；
For j = 0 To UBound(s) '累计汇总字段，有7个字段要累计的，所以执行 ...

多谢指导

但
对本例
If-----Then------Else 选择语句结构还是不太明白（也就是：Else后面的循环语句----数组arr2 怎么能 上下关联呢？？？？）

说明：是对本实例结构下的If-----Then------Else不懂
对于
其它实例下的If-----Then------Else结构，大部份内容，能看懂
例如：楼主在本主题贴下的实例
  If d.Exists("c") Then
      msg = "指定的关键字已经存在。"
    Else
      msg = "指定的关键字不存在。"
    End If
这实例下的If-----Then------Else选择结构，很容易理解，原因是：两个表达式语句块没有相关的联系

再例如：
If ComboBox1.Value = "" And TextBox1.Value = "" Then        
   Sq = "Select  * from 货品基础资料表  "
Else
Sq = "Select  * from 货品基础资料表 WHERE " & ComboBox1.Value & " LIKE   '%" & TextBox1.Value & "%' "   
End If
这个If-----Then------Else选择结构
也
很容易理解，原因是：这两个表达式语句块都是独立的

[ 本帖最后由 lym321 于 2010-10-24 07:05 编辑 ]

lym321

请教
以下代码
如果
不用
If-----Then------Else结构
该怎样去修改（例如：修改成顺序结构）

或者
修改成
本菜
能明白的选择结构也可
谢谢！！！

Sub AAA()
Dim n As Long
Dim A As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim arr
Dim arr2()
Dim s
Dim temp As String
Dim d As Object

Application.ScreenUpdating = False

n = Sheet1.[a65536].End(xlUp).Row - 1 '原始数据行数
arr = Sheet1.[A2].Resize(n, 27) '赋值给数组arr
ReDim arr2(1 To n, 1 To 27)
s = Array(18, 19, 20, 21, 22, 23, 27) '汇总字段
Set d = CreateObject("scripting.dictionary") '创建字典

For i = 1 To n
    temp = arr(i, 9) & vbTab & arr(i, 10) & vbTab & arr(i, 15) & vbTab & arr(i, 17) & vbTab & arr(i, 26) '汇总的根据字段
   
    If Not d.exists(temp) Then '如果尚无记录
        k = k + 1 '新数组行索引加1
        d.Add temp, k
        For A = 1 To 27 '整行复制
        arr2(k, A) = arr(i, A)
        Next
   
   Else

       For j = 0 To UBound(s) '累计汇总字段
       arr2(d(temp), s(j)) = arr2(d(temp), s(j)) + arr(i, s(j))
       Next
  End If
  Next
Set d = Nothing '释放字典对象
Sheet2.[b:b,n:n,p:p].NumberFormatLocal = "@"
Sheet2.[A1].Resize(n, 27) = arr2 '新的数据表格式放于sheet2
Application.ScreenUpdating = True '允许刷屏
MsgBox "ok"
End Sub

smsr008

好，真强大，谢谢楼主的无私分享

hhaa999

支持蓝桥，代码容易理解，入门的好工具