我可以缩短代码执行时间吗?

时间:2015-10-13 05:24:22

标签: vba excel-vba runtime excel

此代码需要10秒以上才能完成。有更快的方法吗?

如果一行中的特定单元格由" H"然后字符隐藏整行,并在这里用给定的背景颜色解释单元格的内容,它的索引代码是19。

Option Explicit

Sub TailoredInputs()
Dim ws As Worksheet
Dim i, j, l As Integer

Set ws = Sheets("Inputs")
Application.ScreenUpdating = False

Range("A7:A200").EntireRow.Hidden = False

With ws
    .Select
    j = 10

    Do While j <= 149

        If .Cells(j, "J").Value = "H" Then
            For l = 4 To 9
                If .Cells(j, l).Interior.ColorIndex = 19 Then
                    .Cells(j, l).ClearContents
                 Else: End If
             Next l

            .Cells(j, "J").EntireRow.Hidden = True

        Else: End If

        If .Cells(j, "K").Value = "H" Then
            For l = 4 To 9
                If .Cells(j, l).Interior.ColorIndex = 19 Then
                    .Cells(j, l).ClearContents
                Else: End If
            Next l

            .Cells(j, "J").EntireRow.Hidden = True

        Else: End If 

        j = j + 1
    Loop   

    Range("Spendinginput").Select  

End With

Application.ScreenUpdating = True
End Sub

2 个答案:

答案 0 :(得分:1)

我要看的第一件事就是摆脱第10到149行的显式循环。

您可以使用Range.Find方法在您感兴趣的范围内找到包含H的第一个单元格。与所有可能的优化一样,您应该检查它,但我会想象Excel搜索封面下的值可能比手动检查每个单元格更快。

例如,请考虑以下代码:

Option Explicit
Public Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long

Sub Macro1()
    Dim ws As Worksheet
    Dim j As Integer
    Dim t As Long
    Dim x As Range

    If False Then ' or use true for explicit loop '
        t = GetTickCount
        j = 1
        Do While j <= 9999
            If Worksheets(1).Cells(j, 1).Value = "H" Then
                MsgBox ("found it " & j & " " & (GetTickCount - t))
                j = 10000
            End If
            j = j + 1
        Loop
    Else
        t = GetTickCount
        Set x = Range("A1:A9999").Find("H")
        MsgBox ("found it " & x.Row & " " & (GetTickCount - t))
    End If
End Sub

true语句中的if(显式循环)和单元格H中只有A9999的工作表,查找值大约需要46毫秒。使用Range.Find()方法将其降为零。

答案 1 :(得分:1)

未测试:

Sub TailoredInputs()
    Dim ws As Worksheet
    Dim i, j, l As Integer, rngHide As Range

    Set ws = Sheets("Inputs")
    Application.ScreenUpdating = False

    ws.Range("A7:A200").EntireRow.Hidden = False

    For j = 10 To 149
        If ws.Cells(j, "J").Value = "H" Or ws.Cells(j, "K").Value = "H" Then
            For l = 4 To 9
                If ws.Cells(j, l).Interior.ColorIndex = 19 Then
                     ws.Cells(j, l).ClearContents
                End If
            Next l
            'build the range which will be hidden
            If rngHide Is Nothing Then
                Set rngHide = ws.Cells(j, 1)
            Else
                Set rngHide = Application.Union(rngHide, ws.Cells(j, 1))
            End If

        End If
    Next j

    'anything to hide?  Hide it.
    If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True

    ws.Range("Spendinginput").Select

    Application.ScreenUpdating = True
End Sub