VBA類似的代碼工作完全在一個工作表，而不是其他

我寫了下面的代碼爲我的工作表中的一個。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

有沒有人有任何想法，爲什麼這是這種情況？

謝謝！

來源

2017-08-01 pampk

您試圖隱藏某個點已經隱藏的行，我猜可能 – krib

這很可能是你的活動工作表是不是你打算去努力的人。它始終是最好避免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

來源

2017-08-01 11:57:03

感謝您的建議！不幸的是，代碼仍然很慢。我想我可能不得不爲這一條扔掉毛巾。 – pampk

@pampk看起來很奇怪，它會很慢。其他加速代碼的方法是關閉自動計算並禁用事件（如果修改表單觸發事件）。使用'Application.Calculation = xlManual'和'Application.EnableEvents = False'。只要確保在最後回頭。 –

你能試着給你的代碼完整地址，你的細胞？此外，不使用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

讓我知道如果錯誤消息繼續出現。

來源

2017-08-01 11:59:22 Pspl

代碼確實在正確的表單上運行。問題在於代碼的速度。我已經試過你的代碼，它只需要很長時間。感謝您的輸入！ – pampk

我現在明白了（也感謝@ Vityata的回答）......我總是知道隱藏/顯示列隱藏/顯示行更快。我只是不知道差別那麼大！然而，對於少於400行的樣本花了這麼長時間（我試過一個大文件上的代碼，它需要5秒鐘），這有點奇怪......也可能是自動Excel計算。。也許你可以用'Application.Calculation = xlCalculationManual'開始你的代碼，並用'Application.Calculation = xlCalculationAutomatic'結束它... – Pspl

顯然列次快躲比行。我曾經嘗試這樣做：

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

來源

2017-08-01 11:59:30 Vityata

這真的會清理一些東西，謝謝！ – pampk

@pampk - 歡迎您:) – Vityata

你的主要增長放緩是從工作表太多次讀取數據的結果。首先將單元格值加載到數組中，然後循環。

您也可以通過一開始就一次取消隱藏行來獲得一點速度，然後隱藏「=」Project「條件爲true。同樣，這會減少對工作表的調用次數;您的當前版本逐一設置每行的「。隱藏」屬性。

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

如果您擔心速度真的，你也可以通過檢查包含「項目」連續的行車次減少到工作表的數量。這個版本的運行速度是另一個版本的兩倍（在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

來源

2017-08-01 19:37:15

嗨丹尼爾，非常感謝您的幫助，上面的代碼完美無缺！ – pampk

VBA類似的代碼工作完全在一個工作表，而不是其他

回答

相關問題