[已解决]宏运行错误

昆山

表格达到接近33000行时，不能运行宏。
还请大侠帮忙看看如下宏。
谢谢了！

附件太大了，不能上传，附宏如下：

Sub 汇总()

Dim d As Object, i%, j%, arr, brr, crr, row1&
Set d = CreateObject("scripting.dictionary")        

row1 = Sheet1.Range("D1048576").End(3).Row         
j = 1

arr = Sheet1.Range("c2:g" & row1)

For i = 1 To UBound(arr)（运行到这里出错）

    If Not d.exists(arr(i, 1) & "," & arr(i, 2)) Then     
         d.Add arr(i, 1) & "," & arr(i, 2), arr(i, 5)               
    Else
        d(arr(i, 1) & "," & arr(i, 2)) = d(arr(i, 1) & "," & arr(i, 2)) + arr(i, 5)
    End If

Next

brr = d.keys
crr = d.items

ReDim drr(1 To d.Count, 1 To 3)

For i = 0 To UBound(brr)
    If crr(i) <> 0 Then
        drr(j, 1) = Split(brr(i), ",")(0)
        drr(j, 2) = Split(brr(i), ",")(1)
        drr(j, 3) = crr(i)
        j = j + 1
    End If
Next

Sheet2.Range("a2").Resize(d.Count, 3) = drr

Set d = Nothing

End Sub

最佳答案

月排行榜 / 总排行榜

爱疯

2014-12-5 16:28

    Dim d As Object, i%, j%, arr, brr, crr, row1&
改为
    Dim d As Object, i&, j%, arr, brr, crr, row1&


还错吗

跳转到最佳答案楼层

爱疯

    Dim d As Object, i%, j%, arr, brr, crr, row1&
改为
    Dim d As Object, i&, j%, arr, brr, crr, row1&


还错吗

昆山

附图

爱疯

只留10行数据，上传，再看。

昆山

只剩十行的表，请见附件。

qh8600

昆山 发表于 2014-12-5 17:04
只剩十行的表，请见附件。

没问题啊

昆山

qh8600 发表于 2014-12-5 17:43
没问题啊

接近33000行时，就提示“溢出”出错了。

昆山

超过2003表格一半行数（65536行的一半）的时候，就不能运行了。

昆山

出错提示如图

qh8600

昆山 发表于 2014-12-5 20:35
出错提示如图

字典放不下吧，内存溢出了