[已解决][已添加附件]老师们好，请问以下该功能如何优化才能提速啊！！！谢谢

fuxuanbo

Sub qh()

Dim Rg1 As Range
Dim Rg2 As Range
Dim Rg3 As Range
Dim Rg4 As Range
Set Rg1 = Sheets("定额").Range("B6:E2000")
Set Rg3 = Sheets("定额").Range("E6:E2000")

    Dim n
    For n = 3 To 2000
        Set Rg2 = Sheets("机械定额").Cells(n, 2)
        Sheets("机械定额").Cells(n, 5) = Application.WorksheetFunction.SumIf(Rg1, Rg2, Rg3)
        Set Rg4 = Sheets("仪表定额").Cells(n, 2)
        Sheets("仪表定额").Cells(n, 5) = Application.WorksheetFunction.SumIf(Rg1, Rg4, Rg3)
    Next n

End Sub

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-5-26 13:26

1. Sub aaa()
   
2. Dim arr, d As Object, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets("定额").[b6:e2000]
   
5. For i = 1 To UBound(arr)
   
6.   d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 4)
   
7. Next i
   
8. arr = Sheets("机械定额").Range("b3:b" & Sheets(2).[b65536].End(3).Row)
   
9. For i = 1 To UBound(arr)
   
10.   arr(i, 1) = d(arr(i, 1))
    
11. Next i
    
12. Sheets("机械定额").[e3].Resize(UBound(arr)) = arr
    
13. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, d As Object, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets("定额").[b6:e2000]
   
5. For i = 1 To UBound(arr)
   
6.   d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 4)
   
7. Next i
   
8. arr = Sheets("机械定额").Range("b3:b" & Sheets(2).[b65536].End(3).Row)
   
9. For i = 1 To UBound(arr)
   
10.   arr(i, 1) = d(arr(i, 1))
    
11. Next i
    
12. Sheets("机械定额").[e3].Resize(UBound(arr)) = arr
    
13. End Sub

复制代码