[已解决]请问如何加快VBA运算速度?

lgfcl

请问sumif函数在VBA中运算时速度超慢，据说可以用内存什么的加快运算速度，请问怎么写呀？（根据下面的代码）谢谢！

Sub ttt()
    With sheet3
         For i = 2 To 1000
            .Cells(i, 12) = Application.WorksheetFunction.SumIf(Sheet1.[a:a], .Cells(i, 11), Sheet1.[b:b])
         Next
    End With
  End If
End Sub

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2015-8-17 14:11

lgfcl 发表于 2015-8-17 13:49
单元格L2 金额取不出来？

可以了。

1. Sub ttt()
   
2. Dim arr, Dic
   
3. arr = Sheet1.UsedRange
   
4. Set Dic = CreateObject("scripting.dictionary")
   
5.          For a = 2 To UBound(arr)
   
6.                Dic(arr(a, 1)) = Dic(arr(a, 1)) + Val(arr(a, 2))
   
7.          Next
   
8. arr = Sheet3.Range(Sheet3.[L2], Sheet3.Cells(Rows.Count, "K").End(3))
   
9.          For a = 1 To UBound(arr)
   
10.                 arr(a, 2) = Dic(arr(a, 1))
    
11.          Next
    
12. Sheet3.Range(Sheet3.[L2], Sheet3.Cells(Rows.Count, "K").End(3)) = arr
    
13. End Sub

复制代码

跳转到最佳答案楼层

上清宫主

忘掉你的工作表函数，用真正的VBA，速度自然就快了

gufengaoyue

见6楼代码。

lgfcl

dic(arr(a,11)) = dic(arr(a,11)) + val(arr(a,2))
运行时错误代码9 ，下标出界？

lgfcl

gufengaoyue 发表于 2015-8-17 11:30
没有文件可以测，只是根据你的代码意思来理解的。
你自己先试试，如果不行，再把你的文件发个上来看看。

运行时有错误提示框？麻烦帮看一下，谢谢！

gufengaoyue

lgfcl 发表于 2015-8-17 13:09
运行时有错误提示框？麻烦帮看一下，谢谢！

改成这样。试试吧。

1. Sub ttt()
   
2. Dim arr, Dic
   
3. arr = Sheet1.UsedRange
   
4. Set Dic = CreateObject("scripting.dictionary")
   
5.          For a = 2 To UBound(arr)
   
6.                Dic(arr(a, 1)) = Dic(arr(a, 1)) + Val(arr(a, 2))
   
7.          Next
   
8. arr = Sheet3.Range(Sheet3.[L2], Sheet3.Cells(Rows.Count, "K").End(3))
   
9.          For a = 1 To UBound(arr)
   
10.                 arr(a, 2) = Dic(arr(a, 1))
    
11.          Next
    
12. Sheet3.Range(Sheet3.[L2], Sheet3.Cells(Rows.Count, "K").End(3)) = arr
    
13. End Sub

复制代码

上清宫主

改自你5楼附件：
Sub ttt()
Dim arr, Dic
arr = Sheets("sheet1").Range("a1").CurrentRegion.Value
Set Dic = CreateObject("scripting.dictionary")
For a = 2 To UBound(arr)
        Dic(arr(a, 1)) = Dic(arr(a, 1)) + Val(arr(a, 2))
Next
Sheets("sheet3").Range("k2").Resize(Dic.Count) = Application.Transpose(Dic.keys)
Sheets("sheet3").Range("l2").Resize(Dic.Count) = Application.Transpose(Dic.items)
End Sub

lgfcl

gufengaoyue 发表于 2015-8-17 13:22
改成这样。试试吧。

单元格L2 金额取不出来？

gufengaoyue

lgfcl 发表于 2015-8-17 13:49
单元格L2 金额取不出来？

可以了。

1. Sub ttt()
   
2. Dim arr, Dic
   
3. arr = Sheet1.UsedRange
   
4. Set Dic = CreateObject("scripting.dictionary")
   
5.          For a = 2 To UBound(arr)
   
6.                Dic(arr(a, 1)) = Dic(arr(a, 1)) + Val(arr(a, 2))
   
7.          Next
   
8. arr = Sheet3.Range(Sheet3.[L2], Sheet3.Cells(Rows.Count, "K").End(3))
   
9.          For a = 1 To UBound(arr)
   
10.                 arr(a, 2) = Dic(arr(a, 1))
    
11.          Next
    
12. Sheet3.Range(Sheet3.[L2], Sheet3.Cells(Rows.Count, "K").End(3)) = arr
    
13. End Sub

复制代码