ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
楼主: 蓝桥玄霜

[原创] 常见字典用法集锦及代码详解

    [复制链接]

TA的精华主题

TA的得分主题

发表于 2018-12-14 17:43 | 显示全部楼层
本帖已被收录到知识树中,索引项:数组集合和字典
感谢蓝版,找了很多帖子看,才看到这个帖子,看来对论坛还是不熟悉;很详细,很实用,很有帮助

TA的精华主题

TA的得分主题

发表于 2018-12-18 17:48 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-12-20 15:44 | 显示全部楼层
蓝桥玄霜 发表于 2010-10-18 12:50
实例3  A列中显示1 ~ 1000中被6除余1和余5 的数字
一、问题的提出:
有1、2、3…1000一千个数字,要求编 ...

蓝版,山菊花的代码运行结果和你的不一样啊,如果将金立A10改为A金立10,你的代码就运行结果是正常的,为国产大牌,但是山菊花的代码执行完就把A金立10当做其它品牌。代码怎么改啊?

TA的精华主题

TA的得分主题

发表于 2018-12-24 22:56 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-12-29 16:07 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-12-31 11:25 | 显示全部楼层
本帖最后由 xiao0527 于 2019-1-1 11:21 编辑

进入论坛已经有段时间了,还是局限用一些公式,有点时间也想看看vba.对数组 字典了解比较少,看了版主的字典学习,有许多问题了解比如字典数组和数组
如代码
Sub bbhz()
Dim i&, Myr&, x(1 To 3), Arr, n%, aa, j&, Arr1(), r%, Arr2(), r2%, r3%, Arr3()
Dim d(1 To 3) As New dictionary, k(1 To 3), t(1 To 3), js, ks, ii%, jj&, ks1, js1
Application.ScreenUpdating = False
Myr = Sheet1.[a65536].End(xlUp).Row
Arr = Sheet1.Range("a3:g" & Myr)
For i = 1 To UBound(Arr)
    x(1) = Arr(i, 2)
    d(1)(x(1)) = d(1)(x(1)) + Arr(i, 3)
    x(2) = Arr(i, 2) & "|" & Arr(i, 4)
    d(2)(x(2)) = d(2)(x(2)) + Arr(i, 5)
    x(3) = Arr(i, 2) & "|" & Arr(i, 4) & "|" & Arr(i, 6)
    d(3)(x(3)) = d(3)(x(3)) + Arr(i, 7)
Next
For i = 1 To 3
    k(i) = d(i).Keys
    t(i) = d(i).Items
Next
Sheet4.Activate
[a3:k1000].ClearContents
[a3:k1000].UnMerge
[a3:k1000].Borders.LineStyle = xlNone
[i3].Resize(d(3).Count, 1) = Application.Transpose(t(3))
n = 2
For i = 0 To UBound(k(3))
    aa = Split(k(3)(i), "|")
    n = n + 1
    Cells(n, 2) = aa(0)
    Cells(n, 4) = aa(1)
    Cells(n, 8) = aa(2)
Next
For i = 3 To n
    For j = 0 To UBound(k(1))
        If Cells(i, 2) = k(1)(j) Then
            Cells(i, 3) = t(1)(j)
            Cells(i, 10) = Cells(i, 9) / Cells(i, 3)
            Cells(i, 11) = Cells(i, 10): Exit For
        End If
    Next
    For j = 0 To UBound(k(2))
        If Cells(i, 2) & "|" & Cells(i, 4) = k(2)(j) Then
            Cells(i, 5) = t(2)(j)
            Cells(i, 6) = Cells(i, 5) / Cells(i, 3)
            Cells(i, 7) = Cells(i, 6): Exit For
        End If
    Next
Next
Range("a3:k" & n).Sort Key1:=Range("b3"), Order1:=xlAscending, Key2:=Range("d3") _
        , Order2:=xlAscending, Key3:=Range("h3"), Order3:=xlAscending, Header:= _
        xlGuess
For i = 3 To n
    If Cells(i, 2) <> Cells(i - 1, 2) Then
        r = r + 1
        ReDim Preserve Arr1(1 To r)
        Arr1(r) = i
    End If
Next
Application.DisplayAlerts = False
For j = 1 To r
    r3 = 0: r2 = 0
    If j <> r Then
        js = Arr1(j + 1) - 1
    Else
        js = n
    End If
    ks = Arr1(j)
    If js - ks + 1 > 1 Then
        Cells(ks, 1).Resize(js - ks + 1, 1).Merge
        Cells(ks, 2).Resize(js - ks + 1, 1).Merge
        Cells(ks, 3).Resize(js - ks + 1, 1).Merge
    End If
    Cells(ks, 1) = j
    For ii = ks To js
        If ii = ks Then
            r2 = r2 + 1
            ReDim Preserve Arr2(1 To r2)
            Arr2(r2) = ii
        ElseIf Cells(ii, 4) <> Cells(ii - 1, 4) Then
            r2 = r2 + 1
            ReDim Preserve Arr2(1 To r2)
            Arr2(r2) = ii
        End If
    Next
    For ii = 1 To r2
        If ii <> r2 Then
            js1 = Arr2(ii + 1) - 1
        Else
            js1 = js
        End If
        ks1 = Arr2(ii)
        If js1 - ks1 + 1 > 1 Then
            Cells(ks1, 4).Resize(js1 - ks1 + 1, 1).Merge
            For jj = ks1 To js1
                If jj <> ks1 Then
                Cells(ks, 7) = Cells(ks, 7) + Cells(jj, 7)
                End If
            Next
            Cells(ks1, 5).Resize(js1 - ks1 + 1, 1).Merge
            Cells(ks1, 6).Resize(js1 - ks1 + 1, 1).Merge
        Else
            If ii <> 1 Then
            Cells(ks, 7) = Cells(ks, 7) + Cells(ks1, 7)
            End If
        End If
    Next
    Cells(ks, 7).Resize(js - ks + 1, 1).Merge
    For ii = ks To js
        If ii = ks Then
            r3 = r3 + 1
            ReDim Preserve Arr3(1 To r3)
            Arr3(r3) = ii
        ElseIf Cells(ii, 8) <> Cells(ii - 1, 8) Then
            r3 = r3 + 1
            ReDim Preserve Arr3(1 To r3)
            Arr3(r3) = ii
        End If
    Next
    For ii = 1 To r3
        If ii <> r3 Then
            js1 = Arr3(ii + 1) - 1
        Else
            js1 = js
        End If
        ks1 = Arr3(ii)
        If js1 - ks1 + 1 > 1 Then
            Cells(ks1, 8).Resize(js1 - ks1 + 1, 1).Merge
            For jj = ks1 To js1
                If jj <> ks1 Then
                Cells(ks1, 9) = Cells(ks1, 9) + Cells(jj, 9)
                Cells(ks1, 10) = Cells(ks1, 10) + Cells(jj, 10)
                End If
                Cells(ks, 11) = Cells(ks, 11) + Cells(jj, 11)
            Next
            Cells(ks1, 9).Resize(js1 - ks1 + 1, 1).Merge
            Cells(ks1, 10).Resize(js1 - ks1 + 1, 1).Merge
        Else
            If ii <> 1 Then
            Cells(ks, 11) = Cells(ks, 11) + Cells(ks1, 11)
            End If
        End If
    Next
        Cells(ks, 11).Resize(js - ks + 1, 1).Merge
Next
Range("a3:k" & n).Borders.LineStyle = 1
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
刚看第一段,就搞不清楚如:x(1) = Arr(i, 2)  x(1)的值是唯一的,Arr(i, 2)的变化 ,x(1)的值会不停被替换。理解是为变量x的一个元素赋值.前面x(1 To 3)应该是声明数组一维数组x.元素是1,2,3.  
那么 声明数组一维数组k(1 To 3), t(1 To 3),
For i = 1 To 3
    k(i) = d(i).Keys
    t(i) = d(i).Items
Next  这个代码当 i =1时就是 k(1) = d(i).Keys为什么可以赋值数组呢,应该是为D的3个元素赋值可是d(i).Keys数组集合吗。

TA的精华主题

TA的得分主题

发表于 2018-12-31 13:35 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-1-3 10:46 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-1-7 08:47 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-1-8 17:43 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-6-26 14:20 , Processed in 0.112308 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表