[求助]请高手把代码的运行速度给提高点

okk

MJml2gKH.rar (12.74 KB, 下载次数: 27)

2008-6-13 21:51 上传

点击文件名下载附件
[求助]请高手把代码的运行速度给提高点

daley

点击运行也不慢啊,耗时不到1秒。

加一句屏蔽刷新试试；

Sub 按钮1_单击()
    Application.ScreenUpdating = False
    [a:b].ClearContents
    For s = 2 To 101
    For i = 3 To 46
    Cells(s, 2) = Cells(s, i).Value
   
    If Cells(s, 2).Value = 0 Then
    Cells(s, 1) = Cells(s, 1) + 1
   
    ElseIf Cells(s, 1) = "" Then
    Cells(s, 1).Value = 0
    End If
    Next i
    Next s
    Application.ScreenUpdating = True
   
End Sub

maditate

Sub 按钮1_单击()()

[a:b].ClearContents
For s = 2 To 101
   前 = Cells(s, 3).Address
   后 = Cells(s, 46).Address
   区域 = 前 & ":" & 后
  
   Cells(s, 1) = Application.CountIf(ThisWorkbook.Sheets("sheet1").Range(区域), 0)
   Cells(s, 2) = Cells(s, 46)
Next s

End Sub

山菊花

QUOTE:

Sub 按钮1_单击()
t = Timer
Application.ScreenUpdating = False '禁止屏幕刷新，可提高速度。
Application.EnableEvents = False '禁止工作表事件，专心走你的路，不与朋友打招呼。

[a:b].ClearContents
For s = 2 To 101
    For i = 3 To 46
        Cells(s, 2) = Cells(s, i).Value
        If Cells(s, 2).Value = 0 Then
                 Cells(s, 1) = Cells(s, 1) + 1
        ElseIf Cells(s, 1) = "" Then
               Cells(s, 1).Value = 0
        End If
    Next i
Next s
MsgBox "耗时：" & Timer - t
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

QUOTE:

Sub 按钮2_单击()
Application.ScreenUpdating = False
Application.EnableEvents = False

t = Timer
[a:b].ClearContents

For s = 2 To 101

    Cells(s, 1).Value = 0 '把这两行调整到For/Next循环外，减少对单元格操作次数。抄了近路，少走几步，可快点到达。
    Cells(s, 2) = Cells(s, 46).Value
   
    For i = 3 To 46
        If Cells(s, i).Value = 0 Then
             Cells(s, 1) = Cells(s, 1) + 1
        End If
    Next i
   
Next s
MsgBox "耗时：" & Timer - t
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

QUOTE:

Sub 按钮3_单击()
t = Timer
[a:b].ClearContents
sj = Range("a2:at101") '对单元格的操作改为对数组的操作，可提高速度。步行改摩托，快得有点不好意思了。
arr = Range("a2:b101")
For s = 1 To 100
    arr(s, 1) = 0
    arr(s, 2) = sj(s, 46)
    For i = 3 To 46
        If sj(s, i) = 0 Then
            arr(s, 1) = arr(s, 1) + 1
        End If
    Next i
Next s
Range("a2:b101") = arr '将数组的值输出到工作表
MsgBox "耗时：" & Timer - t
End Sub

wzI7ERWA.zip (14.74 KB, 下载次数: 63)

2008-6-20 21:57 上传

点击文件名下载附件
回复：（okk）[求助]请高手把代码的运行速度给提高点

[此贴子已经被作者于2008-6-20 21:59:59编辑过]

okk

佩服![em17][em17][em17]

真不愧是超版,谢谢您.

 

[em23][em23][em23]

okk

同时也谢谢2楼和3楼朋友的帮助

[em23][em23][em23]

gyzzf

山版真是让人佩服呀