[已解决]字典解释？

afad12 · 发表于 2015-1-31 19:38

本帖最后由 afad12 于 2015-1-31 23:36 编辑

Sub abc()
Dim d, d1, Arr, s$, x$, i&, j&, k, t, k1, t1, kk, tt
Sheet1.Activate
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Arr = Range("f6", [m65536].End(3)).Value
For i = 1 To UBound(Arr)
      If Arr(i, 8) <> "" Then
      If Right(Arr(i, 1), 1) = "x" Then
         x = "(" & Arr(i, 2) & "-" & Arr(i, 3) & "-" & Arr(i, 4) & ")": y = Arr(i, 8)
         If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")
         d(x)(y) = d(x)(y) + 1
      ElseIf Right(Arr(i, 1), 1) = "y" Then
         x = "(" & Arr(i, 2) & "-" & Arr(i, 3) & "-" & Arr(i, 4) & ")": y = Arr(i, 8)
         If d1.exists(x) = False Then Set d1(x) = CreateObject("Scripting.Dictionary")
         d1(x)(y) = d1(x)(y) + 1
      End If
      End If
Next
k = d.keys: t = d.items
k1 = d1.keys: t1 = d1.items
s = "x："
For i = 0 To UBound(k)
      s = s & t(i).Count & "个" & k(i)
      kk = t(i).keys: tt = t(i).items
      If t(i).Count = 1 Then
         s = s & kk(0) & "；": js1 = js1 + 2
      Else
         s = s & "："
         For j = 0 To UBound(kk)
            s = s & tt(j) & "个" & kk(j)
            If j <> UBound(kk) Then s = s & "，" Else s = s & "；"
         Next
         js1 = js1 + t(i).Count * 2
      End If
Next
s = s & vbCrLf & "y："
For i = 0 To UBound(k1)
      s = s & t1(i).Count & "个" & k1(i)
      kk = t1(i).keys: tt = t1(i).items
      If t1(i).Count = 1 Then
         s = s & kk(0) & "；": js2 = js2 + 2
      Else
         s = s & "："
         For j = 0 To UBound(kk)
            s = s & tt(j) & "个" & kk(j)
            If j <> UBound(kk) Then s = s & "，" Else s = s & "；"
         Next
         js2 = js2 + t1(i).Count * 2
      End If
Next
Sheet2.Activate
[b14] = s
[b20] = "计数1=" & js1 & vbCrLf & "计数2=" & js2
End Sub

k = d.keys: t = d.items
kk = t(i).keys: tt = t(i).items
k是关键字，t是项目，kk是字典项目的关键字，tt是字典项目的项目，怎么看不懂？

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2015-1-31 22:33

Sub dmeo()
Dim dyh$
dyh = Chr(34) '输出单引号用
Dim d As Object, da As Object, db As Object
Set d = CreateObject("Scripting.Dictionary")
Set d("a") = CreateObject("Scripting.Dictionary")
d("a")("a1") = 1
d("a")("a2") = 2
d("a")("a3") = 3
Set d("b") = CreateObject("Scripting.Dictionary")
d("b")("b1") = 11
d("b")("b2") = 22
d("b")("b3") = 33
Set da = d("a")
Set db = d("b")
Stop
Debug.Print "a1:" & da("a1")
Debug.Print "d(" & dyh & "a" & dyh & ")(" & dyh & "a1" & dyh & "):" & d("a")("a1")
da("a1") = da("a1") + 1
Debug.Print "a1:" & da("a1")
Debug.Print "d(" & dyh & "a" & dyh & ")(" & dyh & "a1" & dyh & "):" & d("a")("a1")
d("a")("a1") = d("a")("a1") + 1
Debug.Print "a1:" & da("a1")
Debug.Print "d(" & dyh & "a" & dyh & ")(" & dyh & "a1" & dyh & "):" & d("a")("a1")
End Sub

复制代码

写了个简单的演示，STOP后你看看本地窗口

跳转到最佳答案楼层

hwc2ycy · 发表于 2015-1-31 21:57

这里是字典嵌套

afad12 · 发表于 2015-1-31 22:27

hwc2ycy 发表于 2015-1-31 21:57
这里是字典嵌套

能详细解释这代码，项目有关键字，项目有项目？

hwc2ycy · 发表于 2015-1-31 22:33

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

Sub dmeo()
Dim dyh$
dyh = Chr(34) '输出单引号用
Dim d As Object, da As Object, db As Object
Set d = CreateObject("Scripting.Dictionary")
Set d("a") = CreateObject("Scripting.Dictionary")
d("a")("a1") = 1
d("a")("a2") = 2
d("a")("a3") = 3
Set d("b") = CreateObject("Scripting.Dictionary")
d("b")("b1") = 11
d("b")("b2") = 22
d("b")("b3") = 33
Set da = d("a")
Set db = d("b")
Stop
Debug.Print "a1:" & da("a1")
Debug.Print "d(" & dyh & "a" & dyh & ")(" & dyh & "a1" & dyh & "):" & d("a")("a1")
da("a1") = da("a1") + 1
Debug.Print "a1:" & da("a1")
Debug.Print "d(" & dyh & "a" & dyh & ")(" & dyh & "a1" & dyh & "):" & d("a")("a1")
d("a")("a1") = d("a")("a1") + 1
Debug.Print "a1:" & da("a1")
Debug.Print "d(" & dyh & "a" & dyh & ")(" & dyh & "a1" & dyh & "):" & d("a")("a1")
End Sub

复制代码

写了个简单的演示，STOP后你看看本地窗口

		自动登录	找回密码
密码			注册