字典scripting.dictionary为什么只能存65536的key

llaby

各路大神，请教一个问题，为什么下面的65536一旦换成比65536大的数字，虽然代码会执行成功，可是运行后的结果是错误的，百思不得其解。是不是字典key存在容量限制，不能超过65536？？
Sub test()
Dim d As Variant, k As Variant, t As Variant
Dim r As Long

Set d = CreateObject("scripting.dictionary")

For r = 1 To 65536
    d(r) = r * 2
Next

k = d.keys
t = d.items

Columns(1).ClearContents
Columns(2).ClearContents

[a1].Resize(d.Count, 1) = Application.Transpose(k)
[b1].Resize(d.Count, 1) = Application.Transpose(t)

End Sub

huang1314wei

主要问题是  Application.Transpose  只支持65536行转置

未忘初心

Transpose 的问题

llaby

哇，感谢huang1314wei和未忘初心，两位大神，茅塞顿开。
现在问题来了，如果不用Transpose，那有什么办法快速输出数据吗？=.=

yeminqiang

llaby 发表于 2017-5-19 09:34
哇，感谢huang1314wei和未忘初心，两位大神，茅塞顿开。
现在问题来了，如果不用Transpose，那有什么办法 ...

用数组，先定义一个范围足够大的数组，再往里面装数据。

幽鼬

llaby 发表于 2017-5-19 09:34
哇，感谢huang1314wei和未忘初心，两位大神，茅塞顿开。
现在问题来了，如果不用Transpose，那有什么办法 ...

把结果放入数组，再放到单元格
redim arr(1 to d.count,1 to 2)
for each k in d.keys
           arr(k,1) = k
           arr(k,2) = d(k)
next
[a1].resize(ubound(arr),2) = arr

paciguard

看来没办法偷懒了，只能用循环，除非不用字典。。。

llaby

谢谢yeminqiang和幽鼬，果然还是大神多啊。搞定了，非常感谢。还学到里新知识。。。^-^

paciguard

脑洞大开，不行硬拆分，实际测试1000000条数据，比循环节省近50秒：
Sub test()
Dim d As Variant, k As Variant, T As Variant
Dim r As Long
Dim t1
t1 = Timer
Set d = CreateObject("scripting.dictionary")
Columns(1).ClearContents
Columns(2).ClearContents
For r = 1 To 1000000
     d(r) = r * 2
     
     If (r Mod 30000) = 0 Then
        If r = 30000 Then
      k = Application.Transpose(d.keys())
      T = Application.Transpose(d.items())
      Range("A" & [a1000000].End(3).Row).Resize(UBound(k), 1) = k
      Range("B" & [b1000000].End(3).Row).Resize(UBound(T), 1) = T
      d.RemoveAll
      Else
      k = Application.Transpose(d.keys())
      T = Application.Transpose(d.items())
      Range("A" & [a1000000].End(3).Row + 1).Resize(UBound(k), 1) = k
      Range("B" & [b1000000].End(3).Row + 1).Resize(UBound(T), 1) = T
      d.RemoveAll
      End If
     ElseIf r = 1000000 Then
     k = Application.Transpose(d.keys())
      T = Application.Transpose(d.items())
            Range("A" & [a1000000].End(3).Row + 1).Resize(UBound(k), 1) = k
      Range("B" & [b1000000].End(3).Row + 1).Resize(UBound(T), 1) = T
     End If
     
Next
MsgBox Timer - t1
End Sub

llaby

paciguard 发表于 2017-5-19 13:50
脑洞大开，不行硬拆分，实际测试1000000条数据，比循环节省近50秒：
Sub test()
Dim d As Variant, k As ...

。。。服了。。。。果然脑洞大开。。。不过确实是个新想法，谢谢了^^