[已解决]【重复数据累计统计】续1

mjola1 · 发表于 2016-12-5 14:03

代码：
Sub tt()
Application.ScreenUpdating = False
Application.Interactive = False
Dim i&, dic As Object, arr1
Set dic = CreateObject("scripting.dictionary")
With Sheet1
      arr1 = .Cells(1, "a").Resize(.Cells(Rows.Count, "a").End(3).Row - 1, 2).Value
      For i = 1 To UBound(arr1)
         dic(arr1(i, 1)) = dic(arr1(i, 1)) + 1
      Next
      For i = 1 To UBound(arr1)
         arr1(i, 2) = dic(arr1(i, 1))
      Next
      .Cells(1, "e").Resize(UBound(arr1), 1) = Application.Index(arr1, , 2)
End With
Dim m&, d As Object, arr2
Set d = CreateObject("scripting.dictionary")
With Sheet1
      arr2 = .Cells(1, "c").Resize(.Cells(Rows.Count, "c").End(3).Row - 1, 2).Value
      For m = 1 To UBound(arr2)
         d(arr2(m, 1)) = d(arr2(m, 1)) + 1
      Next
      For m = 1 To UBound(arr2)
         arr2(m, 2) = d(arr2(m, 1))
      Next
      .Cells(1, "f").Resize(UBound(arr2), 1) = Application.Index(arr2, , 2)
End With
Dim x&‘这是我用笨办法得到了累加统计数
   For x = 1 To 518400
   Cells(x, "e") = Cells(x, "e") - 1
   Cells(x, "b") = Cells(x, "b") + Cells(x, "e")
   Cells(x, "f") = Cells(x, "f") - 1
   Cells(x, "d") = Cells(x, "d") + Cells(x, "f")
Next
  Application.ScreenUpdating = True
  Application.Interactive = True
  End Sub

问题及希望：
1、运行后提示“运行时错误13，类型不匹配”。查找并修改变量类型半天无结果，就用改变行数大小一步一步来试，结果跟预料一样，一超过65536行就错误，65536行都正常运行。可我用的是2013表格，有1048576行，估计还是代码上受到限制，请老师指正。
2、希望精简优化代码，取消e、f两列辅助数据，一步到位直接得到b、d列的累加数据。

最佳答案

月排行榜 / 总排行榜

望帝春心

2016-12-7 10:53