很简单的程序但反应特别慢

好运会来

这个很简单的程序，但反应特别慢。大概得计算1分钟，各位给看看能不能改一下！多谢！！！


Sub sjgx()

    Dim yb, kz, kz2 As Worksheet
    Dim a, b, e, f, x, y, i, z, yy As Long
    'Dim sumRange As Range
    'Set yb = Sheets("工程量清单明细表")
   Set kz = Sheets("数据表")
    '获取最后一行的行号
    a = kz.[A65536].End(xlUp).Row
     '获取最后一列的列号
    b = kz.Cells(3, Columns.Count).End(xlToLeft).Column
     ' 获取需要求和的数据范围


    For i = 4 To a
     kz.Cells(i, 15) = kz.Cells(i, b)
     e = WorksheetFunction.Sum(Range(kz.Cells(i, 17), kz.Cells(i, b)))
     If e > 0 Then
      Cells(i, 12) = e
     Else: Cells(i, 12) = ""
      End If

    Next i
  MsgBox "程序已执行完成。"
End Sub

excel玉米

liulang0808

在目前代码上调整建议：
修改表格区域数据，建议application.ScreenUpdating 属性先设置为false，后设置为true，分别在代码起始跟终止前设置。
另外表格如果有工时，如果不影响提取结果的前提下，公式先设置手动，后设置自动。

以上修改如果速度还慢的话，建议考虑使用数组

好运会来

excel玉米 发表于 2023-3-19 06:33

谢谢，我试试。程序运行没问题，就是慢。

fzxba

1. Sub sjgx()
   
2.   Dim ar, i As Long, j As Long, k As Double
   
3.   With Worksheets("数据表")
   
4.     i = .[A65536].End(xlUp).Row
   
5.     j = .Cells(3, Columns.Count).End(xlToLeft).Column
   
6.     ar = .Range("L4", .Cells(i, j))
   
7.     For i = 1 To UBound(ar)
   
8.       k = 0
   
9.       For j = 6 To UBound(ar, 2)
   
10.         k = k + Val(ar(i, j))
    
11.       Next
    
12.       If k > 0 Then ar(i, 1) = k Else ar(i, 1) = ""
    
13.       ar(i, 4) = ar(i, UBound(ar, 2))
    
14.     Next
    
15.     .Range("L4").Resize(UBound(ar)) = WorksheetFunction.Index(ar, 0, 1)
    
16.     .Range("O4").Resize(UBound(ar)) = WorksheetFunction.Index(ar, 0, 4)
    
17.   End With
    
18. End Sub

复制代码

ZHLK

上传附件看看

gwjkkkkk

上传附件看看。。。

NoooEnd

把sheet读入数组，然后用数组处理

好运会来

fzxba 发表于 2023-3-19 09:06

感谢，这个瞬间就好了