VBA类似的代码在一个工作表上完美运行，但在另一个工作表上不能

时间：2017-08-01 11:41:35

标签： excel vba excel-vba

我为我的一个工作表编写了以下代码。

Sub Hide_Projects()
    Application.ScreenUpdating = False
        i = 6
        For i = 6 To 350
            Cells(9, i).Select
            If Selection.Value = "Project" Then
                ActiveCell.EntireColumn.Hidden = True
            Else
                ActiveCell.EntireColumn.Hidden = False
            End If
        Next i
    Application.ScreenUpdating = True
End Sub

它工作正常，每次都能满足我的需求而不会崩溃或滞后。但是，当我在不同的工作表上使用类似的代码时，只有这次应用于行而不是列，它会崩溃我的Excel或运行大约2分钟，即使代码是相同的。这是第二个代码：

Sub Hide_Projects_5yr()
    Application.ScreenUpdating = False
    i = 6
        For i = 6 To 350
            Cells(i, 7).Select
            If Selection.Value = "Project" Then
                ActiveCell.EntireRow.Hidden = True
            Else
                ActiveCell.EntireRow.Hidden = False
            End If
        Next i
    Application.ScreenUpdating = True
End Sub

有谁知道为什么会这样？

谢谢！

4 个答案:

答案 0 :(得分：4)

显然列的隐藏时间比行快一些。我试过这个：

Option Explicit

Public Sub TestingSpeed()

    Dim lngCount    As Long
    Dim dtTime      As Date


    Columns.Hidden = False
    rows.Hidden = False

    dtTime = Now
    For lngCount = 1 To 300
        rows(lngCount).Hidden = True
    Next lngCount
    Debug.Print "Rows: -> "; DateDiff("s", dtTime, Now())

    dtTime = Now
    For lngCount = 1 To 300
        Columns(lngCount).Hidden = True
    Next lngCount
    Debug.Print "Cols: -> "; DateDiff("s", dtTime, Now())

End Sub

结果如下（以秒为单位）：

Rows: ->  9 
Cols: ->  2

差异以某种方式成倍增长。

使用 1.000 样本，就像这样：

Rows: ->  11 
Cols: ->  1

10.000 像这样：

Rows: ->  19 
Cols: ->  10

答案 1 :(得分：1)

您的活动工作表很可能不是您打算使用的工作表。最好避免使用Select和ActiveCell，因为您依赖于光标位置。不确定您是否需要虚假案例，除非您反复使用相同的工作表并且可能会被隐藏。

Sub Hide_Projects_5yr()
    Application.ScreenUpdating = False
    Dim ws as Worksheet
    Set ws = Sheets("YourSheetName")
        For i = 6 To 350

            If ws.Cells(i, 7).Value = "Project" Then
                ws.Cells(i, 7).EntireRow.Hidden = True
            Else
                ws.Cells(i, 7).EntireRow.Hidden = False
            End If
        Next i
    Application.ScreenUpdating = True
End Sub

答案 2 :(得分：0)

您可以尝试将代码的完整地址提供给您的单元格吗？此外，不使用select命令是个好主意。这是我对您的代码的修改：

Sub Hide_Projects()
    Application.ScreenUpdating = False
        With ThisWorkbook.Sheets("Put the name of your sheet here")
            For i = 6 To 350
                If .Cells(9, i).Text = "Project" Then
                    .Columns(i).Hidden = True
                Else
                    .Columns(i).Hidden = False
                End If
            Next i
        End With
    Application.ScreenUpdating = True
End Sub

您的第二个代码如下所示：

Sub Hide_Projects_5yr()
    Application.ScreenUpdating = False
        With ThisWorkbook.Sheets("Put the name of your second sheet here")
            For i = 6 To 350
                If .Cells(i, 7).Text = "Project" Then
                    .Rows(i).Hidden = True
                Else
                    .Rows(i).Hidden = False
                End If
            Next i
        End With
    Application.ScreenUpdating = True
End Sub

如果错误消息一直显示，请告诉我。

答案 3 :(得分：0)

您的主要减速是因为多次从工作表中读取数据。首先将单元格值加载到数组中，然后遍历该数组。

你也可以通过在开始时一次取消隐藏行来获得一点速度，然后在“=”Project“条件为真时隐藏。再次，这会减少对工作表的调用次数;当前版本逐行设置每行的“.Hidden”属性。

Application.ScreenUpdating = False

Dim i As Long
Dim j As Long

Dim tempArr As Variant
tempArr = Range(Cells(6, 7), Cells(350, 7)).Value

Rows("6:350").Hidden = False

j = 1
For i = LBound(tempArr, 1) To UBound(tempArr, 1)
    If tempArr(i, 1) = "Project" Then
        Rows(j + 5).Hidden = True
    End If
    j = j + 1
Next

Application.ScreenUpdating = True

如果您真的关注速度，您还可以通过检查包含“Project”的连续行来减少到工作表的行程次数。这个版本的运行速度是另一个版本的2倍（在200k行的样本上测试）。但是，它使代码更加复杂。

Application.ScreenUpdating = False

Dim i As Long
Dim j As Long
Dim k As Long
Dim tempArr As Variant
Dim consBool As Boolean

tempArr = Range(Cells(6, 7), Cells(350, 7)).Value

Rows("6:350").Hidden = False
j = 1

For i = LBound(tempArr, 1) To UBound(tempArr, 1)
    consBool = True
    If tempArr(i, 1) = "Project" Then
        k = i
        Do Until consBool = False
            If k = UBound(tempArr, 1) Then
                consBool = False
            ElseIf tempArr(k + 1, 1) = "Project" Then
                k = k + 1
            Else
                consBool = False
            End If
        Loop
        Rows(j + 5 & ":" & k + 5).Hidden = True
        j = j + 1 + (k - i)
        i = k
    Else
        j = j + 1
    End If
Next

Application.ScreenUpdating = True

如果我要在一个更大的项目中实现它，那就是它的样子。在其他优化中，我添加了一些功能（它可以检查部分匹配，检查多个列符合您的条件，并执行“反转”模式，隐藏所有行不包含您的标准）并制作确保您需要指定工作表。

Option Explicit
Sub exampleMacro()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Call hideRows(ThisWorkbook.Sheets("Example WS"), 6, 350, "Project", 7, 7)

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
Sub hideRows(ws As Worksheet, startRow As Long, endRow As Long, valCrit As String, Optional startCol As Long = 1, Optional endCol As Long = 1, Optional invert As Boolean = False, Optional checkAll As Boolean = False)
'Hides rows in a range (startRow to endRow) in a worksheet (ws)
'Hides when row contains a value (valCrit; partial strings are accepted) in a column or series of columns (startCol to endCol)
'In inverted mode (invert), hides rows that do *not* contain value
'If (checkAll) is True, all columns must contain value to be hidden/unhidden
'Usage examples:
    'Call hideRows(exampleWS, 1, 1000, "Foo", 1, 10) -> hides rows that contain a cell in columns 1-10 with exact value "Foo"
    'Call hideRows(exampleWS, 1, 1000, "*Foo*", 1, 10) -> hides rows that contain a cell in columns 1-10 that contains partial string "*Foo*"
    'Call hideRows(exampleWS, 1, 1000, "Foo", 1, 10, True) -> hides rows that contain no cells in columns 1-10 with exact value "Foo"
    'Call hideRows(exampleWS, 1, 1000, "Foo", 1, 10, False, True) -> hides rows in which all cells in columns 1-10 contain the exact value "Foo"
    'Call hideRows(exampleWS, 1, 1000, "Foo", 1, 10, True, True) -> hides rows in which no cells in columns 1-10 contain the exact value "Foo"

    Dim loopCounter As Long
    Dim rowCounter As Long
    Dim colCounter As Long
    Dim endConsRow As Long
    Dim tempArr As Variant
    Dim toAdd As Long
    Dim toHide As String
    Dim consBool As Boolean
    Dim tempBool As Boolean
    Dim rowStr As String
    Dim goAhead As Boolean
    Dim i As Long

    If startRow > endRow Then
        toAdd = endRow - 1
    Else
        toAdd = startRow - 1
    End If

    ws.Rows(startRow & ":" & endRow).Hidden = False
    tempArr = ws.Range(ws.Cells(startRow, startCol), ws.Cells(endRow, endCol)).Value

    loopCounter = 1
    For rowCounter = LBound(tempArr, 1) To UBound(tempArr, 1)
        For colCounter = LBound(tempArr, 2) To UBound(tempArr, 2)
            goAhead = False
            If tempArr(rowCounter, colCounter) Like valCrit Then
                If (Not checkAll) Or (colCounter = UBound(tempArr, 2)) Then
                    If invert Then
                        loopCounter = loopCounter + 1
                        Exit For
                    End If
                    goAhead = True
                End If
            ElseIf checkAll Or colCounter = UBound(tempArr, 2) Then
                If Not invert Then
                    loopCounter = loopCounter + 1
                    Exit For
                End If
                goAhead = True
            End If
            If goAhead Then
                endConsRow = rowCounter
                consBool = True
                Do Until consBool = False
                    tempBool = False
                    For i = LBound(tempArr, 2) To UBound(tempArr, 2)
                        If endConsRow = UBound(tempArr, 1) Then
                            Exit For
                        ElseIf tempArr(endConsRow + 1, i) Like valCrit Then
                            If (Not checkAll) Or (i = UBound(tempArr, 2)) Then
                                If Not invert Then
                                    endConsRow = endConsRow + 1
                                    tempBool = True
                                End If
                                Exit For
                            End If
                        ElseIf checkAll Or i = UBound(tempArr, 2) Then
                            If invert Then
                                endConsRow = endConsRow + 1
                                tempBool = True
                            End If
                            Exit For
                        End If
                    Next
                    If Not tempBool Then
                        consBool = False
                    End If
                Loop
                rowStr = loopCounter + toAdd & ":" & endConsRow + toAdd
                If toHide = "" Then
                    toHide = rowStr
                ElseIf Len(toHide & "," & rowStr) > 255 Then
                    ws.Range(toHide).EntireRow.Hidden = True
                    toHide = rowStr
                Else
                    toHide = toHide & "," & rowStr
                End If
                loopCounter = loopCounter + 1 + (endConsRow - rowCounter)
                rowCounter = endConsRow
                Exit For
            End If
        Next
    Next

    If Not toHide = "" Then
        ws.Range(toHide).EntireRow.Hidden = True
    End If

End Sub
相关问题
最新问题