ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: 570765393

[求助] 字典查询结果不一致,求解

[复制链接]

TA的精华主题

TA的得分主题

发表于 2023-2-4 17:26 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
APPLE123 发表于 2023-2-4 10:50
请教楼主,原因何在?如何解决的?谢谢!

第一组:因敖东不在总名单里,所以判断敖东时,把敖东加到了字典末尾,所以第一组结束时,敖东就在字典中了。
第二组:因字典中已有敖东,所以判断敖东时,就清除了敖东,所以第二组结束时,敖东就不在字典中了。
第三组:因敖东不在字典中,所以判断敖东时,又把敖东加到了字典末尾,所以第三组结束时,敖东又在字典中了

TA的精华主题

TA的得分主题

发表于 2023-2-4 17:44 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
zjzyj 发表于 2023-2-4 17:26
第一组:因敖东不在总名单里,所以判断敖东时,把敖东加到了字典末尾,所以第一组结束时,敖东就在字典中 ...

谢谢老师的解析!

TA的精华主题

TA的得分主题

发表于 2023-2-5 17:10 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 全党 于 2023-2-5 18:08 编辑

双字典解决,参与一下

TA的精华主题

TA的得分主题

发表于 2023-2-5 17:26 | 显示全部楼层
用两个字典解决


Sub 测试()

    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Dim arr, brr, dic, i, j, k, drr, 字典
        Set dic = CreateObject("Scripting.Dictionary")
        Set 字典 = CreateObject("Scripting.Dictionary")
            Worksheets("培训查询").Range("c2:d6").ClearContents
            arr = Worksheets("名单").Range("a1").CurrentRegion
            brr = Worksheets("培训查询").Range("a2:a6")
            For j = 1 To UBound(brr)
                drr = Split(brr(j, 1), ",")
                   For i = 0 To UBound(drr)
                       Key = drr(i)
                       dic(Key) = ""
                   Next i
                    For i = 2 To UBound(arr)
                       If Not dic.exists(arr(i, 1)) Then 字典(arr(i, 1)) = arr(i, 1)
                    Next i
               Worksheets("培训查询").Range("c" & j + 1) = VBA.Join(字典.Keys, ",")
              k = 字典.Count
              Worksheets("培训查询").Range("d" & j + 1) = k
              dic.RemoveAll
              字典.RemoveAll
            Next j
          Set dic = Nothing
          Set 字典 = Nothing
      Excel.Application.ScreenUpdating = True
      Excel.Application.DisplayAlerts = True
End Sub


TA的精华主题

TA的得分主题

发表于 2023-2-5 19:20 | 显示全部楼层
Sub T()
    Dim d As Object, d1 As Object '声明变量
    Set d名单 = CreateObject("scripting.dictionary")  '设定d为名单字典对象
    Set d培训 = CreateObject("scripting.dictionary") 'd为培训名单字典对象
    arr = Sheet4.Range("A2:A66")
    For j = 1 To UBound(arr)
        d名单(arr(j, 1) & "") = ""
    Next
    最大行 = Sheet5.Range("a" & Rows.Count).End(xlUp).Row
    For i = 2 To 最大行
        brr = Split(Sheet5.Cells(i, 1).Value, ",")
        For j = 0 To UBound(brr)
            d培训(brr(j) & "") = ""
        Next
        jg = ""
        For j = 0 To d名单.Count - 1
            关键字 = d名单.keys()(j)
            If Not d培训.exists(关键字) Then
                jg = jg & "," & 关键字
            End If
        Next
        d培训.RemoveAll
        Sheet5.Cells(i, 3) = Mid(jg, 2)
        k = 0
    Next
End Sub

TA的精华主题

TA的得分主题

发表于 2023-2-5 21:18 | 显示全部楼层
多逛逛这里,总能学习新东西

TA的精华主题

TA的得分主题

 楼主| 发表于 2023-2-6 13:48 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2023-2-25 19:55 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
准提部林 发表于 2023-2-4 15:35
後面加括號的...表示不在總名單中//

谢谢大神
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-19 00:45 , Processed in 0.031721 second(s), 6 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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