Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 546|回复: 23

[已解决] [已解决]字典问题,跟据对应项,输出对应值

[复制链接]
发表于 2017-1-8 16:56 | 显示全部楼层 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
本帖最后由 kmcla 于 2017-1-8 17:53 编辑

1 q
2    w   1   
前两例进入字典,当第三例不为空时,第四例输出对应值
数据量大,必须用字典.
法贾线K0+000
567
法贾线K0+050
?
法贾线K0+050
562
法贾线K0+100
?
法贾线K0+100
569
法贾线K0+150
?
法贾线K0+150
565
法贾线K0+200
?
法贾线K0+200
561
法贾线K0+250
?
法贾线K0+250
567
法贾线K0+300
?
法贾线K0+300
566
法贾线K0+350
?
法贾线K0+350
569
法贾线K0+400
?
法贾线K0+400
562
法贾线K0+450
?
法贾线K0+450
564
法贾线K0+500
?
法贾线K0+500
565
法贾线K0+550
?
法贾线K0+550
563
法贾线K0+600
?
法贾线K0+600
567
法贾线K0+650
?
法贾线K0+650
560
法贾线K0+700
?
法贾线K0+700
562
法贾线K0+750
?
法贾线K0+750
570
 

zjdh发布于 2017-1-8 21:34 |显示全部回帖
Sub TEST()
    Set D = CreateObject("scripting.dictionary")
    ARR = Range("A2:B" & Range("A65536").End(3).Row)
    For I = 1 To UBound(ARR)
        D(ARR(I, 1)) = ARR(I, 2)
    Next
    ARR = Range("D2:D" & Range("D65536").End(3).Row)
    For I = 1 To UBound(ARR)
        ARR(I, 1) = D(ARR(I, 1))
    Next
    Range("E2").Resize(UBound(ARR), 1) = ARR
End Sub

Book1.rar (13.45 KB, 下载次数: 12)
发表于 2017-1-9 14:02 | 显示全部楼层
本帖最后由 zjdh 于 2017-1-9 14:14 编辑

Sub test()
    Set d = CreateObject("Scripting.Dictionary")
    ARR = Sheets("垫原").Range("A1:Q" & Sheets("垫原").Range("A65536").End(3).Row)
    For I = 1 To UBound(ARR) Step 50
        For J = 2 To 17
            d(ARR(I + 5, J)) = Array(ARR(I + 9, J) / 100, ARR(I + 12, J))
    Next: Next
    ARR = Sheets("垫宽").Range("A1:P" & Sheets("垫宽").Range("A65536").End(3).Row)
    For I = 1 To UBound(ARR) Step 50
        For J = I + 6 To I + 29
            If J > UBound(ARR) Then Exit For
            ARR(J, 2) = "": ARR(J, 8) = ""
            If IsArray(d(ARR(J, 1))) Then
                ARR(J, 2) = d(ARR(J, 1))(0)
                If Right(ARR(J, 1), 2) = "00" Then ARR(J, 8) = d(ARR(J, 1))(1)
            End If
    Next: Next
    Sheets("垫宽").Range("A1").Resize(UBound(ARR), UBound(ARR, 2)) = ARR
End Sub

评分

参与人数 1经验 +1 收起 理由
kmcla + 1 在帮一下.一下五没做出来

查看全部评分

回复 支持 1 反对 0

使用道具 举报

发表于 2017-1-8 21:34 | 显示全部楼层    本楼为最佳答案   
Sub TEST()
    Set D = CreateObject("scripting.dictionary")
    ARR = Range("A2:B" & Range("A65536").End(3).Row)
    For I = 1 To UBound(ARR)
        D(ARR(I, 1)) = ARR(I, 2)
    Next
    ARR = Range("D2:D" & Range("D65536").End(3).Row)
    For I = 1 To UBound(ARR)
        ARR(I, 1) = D(ARR(I, 1))
    Next
    Range("E2").Resize(UBound(ARR), 1) = ARR
End Sub

Book1.rar (13.45 KB, 下载次数: 12)

评分

参与人数 1经验 +1 收起 理由
kmcla + 1 很给力

查看全部评分

回复 支持 1 反对 0

使用道具 举报

发表于 2017-1-8 17:17 | 显示全部楼层
建议上传Excel文档,其中保留少量数据(确保数量足够说明题意)
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-1-8 17:54 | 显示全部楼层
" Dim d, k, js
   js = Int(Sheets(""垫原"").Cells(600000, 1).End(xlUp).Row / 50) + 1
   Set d = CreateObject(""Scripting.Dictionary"")
   MsgBox js
   For i = 1 To js
     For j = 2 To 17
    If Sheets(""垫原"").Cells((i - 1) * 50 + 10, j) <> """" Then
   
    d.Add Sheets(""垫原"").Cells((i - 1) * 50 + 4, 14) & Sheets(""垫原"").Cells((i - 1) * 50 + 6, j), Sheets(""垫原"").Cells((i - 1) * 50 + 10, j)
End If

    k = d.Keys
    t = d.Items
     Sheets(""目录"").[B60].Resize(d.Count, 1) = Application.Transpose(k)
       Sheets(""目录"").[c60].Resize(d.Count, 1) = Application.Transpose(t)
       Next
      Next"





字典赋完值,不会输出
"         js = Int(Sheets(""垫宽"").Cells(600000, 1).End(xlUp).Row / 50) + 1
   
   MsgBox js
   k = d.Keys
   t = d.Items
   For i = 1 To js
     For j = 7 To 37
    If Sheets(""垫宽"").Cells((i - 1) * 50 + 10, (i - 1) * 50 + j) <> """" And Sheets(""垫宽"").Cells((i - 1) * 50 + 10, (i - 1) * 50 + j) = Application.Transpose(d.Keys) Then
        Sheets(""垫宽"").Cells((i - 1) * 50 + 10, (i - 1) * 50 + j).Resize(0, 1) = d.Items
    End If
       Next
      Next"




我上面的不对

回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-1-8 17:54 | 显示全部楼层
爱疯 发表于 2017-1-8 17:17
建议上传Excel文档,其中保留少量数据(确保数量足够说明题意)

不要看成数值,都是文本.第五行用字典输出对应值
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-1-8 19:16 | 显示全部楼层
爱疯 发表于 2017-1-8 17:17
建议上传Excel文档,其中保留少量数据(确保数量足够说明题意)

老大帮帮我.字典弄不明白
听说字典快,实在不行,只能双数组了.
双数组和字典,差多少?
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-1-8 21:36 | 显示全部楼层
zjdh 发表于 2017-1-8 21:34
Sub TEST()
    Set D = CreateObject("scripting.dictionary")
    ARR = Range("A2:B" & Range("A65536 ...

   Sub 基宽厚()

Dim d, k, js, a1(1 To 10000), a2(1 To 10000), a3(1 To 10000)
js = Int(Sheets("基原").Cells(600000, 1).End(xlUp).Row / 50) + 1
' Set d = CreateObject("Scripting.Dictionary")
'MsgBox js
m = 1
For i = 1 To js
    For j = 2 To 17
        If Sheets("基原").Cells((i - 1) * 50 + 10, j) <> "" Then
            a1(m) = Sheets("基原").Cells((i - 1) * 50 + 4, 14) & Sheets("基原").Cells((i - 1) * 50 + 6, j)
            a2(m) = Sheets("基原").Cells((i - 1) * 50 + 10, j)
            a3(m) = Sheets("基原").Cells((i - 1) * 50 + 13, j)
            m = m + 1
        End If
    Next
Next
js = Int(Sheets("基宽").Cells(600000, 1).End(xlUp).Row / 50) + 1
For i = 1 To js
    For j = 7 To 37
        If Sheets("基宽").Cells((i - 1) * 50 + j, 1) <> "" Then
            a = Sheets("基宽").Cells((i - 1) * 50 + 4, 11) & Sheets("基宽").Cells((i - 1) * 50 + j, 1)
            位置 = Application.Match(a, a1, 0)
            Sheets("基宽").Cells((i - 1) * 50 + j, 2) = a2(位置) / 100
            If 提取数字(Sheets("基宽").Cells((i - 1) * 50 + j, 1)) Mod 100 = 0 Then
                a = Sheets("基宽").Cells((i - 1) * 50 + 4, 11) & Sheets("基宽").Cells((i - 1) * 50 + j, 1)
                位置 = Application.Match(a, a1, 0)
                Sheets("基宽").Cells((i - 1) * 50 + j, 8) = a3(位置) / 1
            End If
        End If
    Next
Next
Set a1 = Nothing
Set a2 = Nothing
Set a3 = Nothing
End Sub

三数组,我做完了,能改成字典吗?

回复 支持 反对

使用道具 举报

发表于 2017-1-8 21:41 | 显示全部楼层
你要上传你的附件(数据量可以少一点),说明要求!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-1-9 08:56 | 显示全部楼层
zjdh 发表于 2017-1-8 21:41
你要上传你的附件(数据量可以少一点),说明要求!

我用上楼的三数组实现了,我想变成字典。表格里红字是要求
帮讲下,数组和字典的差异。都说字典快,我怎么觉得字典就是数组呢。

工作簿1.rar

39.52 KB, 下载次数: 2

回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-1-9 08:59 | 显示全部楼层
zjdh 发表于 2017-1-8 21:41
你要上传你的附件(数据量可以少一点),说明要求!

绿表数值取自红表
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2017-6-26 13:13 , Processed in 0.202800 second(s), 28 queries , Gzip On, Memcache On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

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