Это похоже на другой ответ, но тестирование показывает, что производительность почти на 1,5 порядка (в 70 раз) быстрее благодаря выполнению всех изменений свойств в двух транзакциях; по одному для hideRange.EntireRow.Hidden = True
и unhideRange.EntireRow.Hidden = False
.
В начале файла есть три константы, которые используются для указания столбца, начальной строки, конечной строки и значения, которое необходимо скрыть. Значения OP были включены.
Скопируйте следующий код в конкретный модуль vba WorkSheet. Этот код не будет работать с обычного модуля. Нажмите Alt - F11, чтобы открыть редактор Visual Basic. Нажмите Ctrl - R, чтобы сфокусировать / открыть панель Project Explorer. Перейдите к VBAProject(<file name>)
, Microsoft Excel Objects
и откройте Sheet#(<sheet name>)
где находятся скрытые строки.
Private Sub Worksheet_Calculate()
' Hide Rows if row value in watch_Column is hide_On_Value.
' watch_Column must include start_on row number (e.g. A1 or C3)
' Hidden rows, beyond the range of cells with values, may not
' unhide. For speed, only process rows being used <= end_of_watch.
Const watchColumn = "B45" ' Beginning Cell (row and column) to watch.
Const endOfWatch = "135" ' Last row. if "", rest of rows in use.
Const hideOnValue = 0
Dim hideRange As Range
Dim unhideRange As Range
Dim r As Range
Dim seeRow As Boolean
Dim watchStart() As String
Dim lastRow As String
Dim tmpEnableEvents As Boolean
Set watchRange = Me.UsedRange ' call and discard to reset LastCell
lastRow = Me.Range(watchColumn).SpecialCells(xlCellTypeLastCell).Row
If endOfWatch <> "" Then
If Val(lastRow) > Val(endOfWatch) Then lastRow = endOfWatch
End If
watchStart = Split(Me.Range(watchColumn).Address(True, False), "$")
If Val(watchStart(1)) > Val(lastRow) Then Exit Sub
tmpEnableEvents = Application.EnableEvents
Application.EnableEvents = False
For Each r In Me.Range(watchColumn & ":" & watchStart(0) & lastRow)
seeRow = True
If IsEmpty(r) Then
ElseIf CStr(r.Value2) = vbNullString Then
ElseIf r = hideOnValue Then
seeRow = False
If Not r.EntireRow.Hidden Then
If hideRange Is Nothing Then
Set hideRange = r
Else
Set hideRange = Union(hideRange, r)
End If
End If
End If
If seeRow And r.EntireRow.Hidden Then
If unhideRange Is Nothing Then
Set unhideRange = r
Else
Set unhideRange = Union(unhideRange, r)
End If
End If
Next r
If Not unhideRange Is Nothing Then
unhideRange.EntireRow.Hidden = False
End If
If Not hideRange Is Nothing Then
hideRange.EntireRow.Hidden = True
End If
Application.EnableEvents = tmpEnableEvents
End Sub