Как можно настроить этот VBA

Question

По вашему запросу Оригинальный пост здесь Как скрыть строки на основе значения ячейки

Я получил VBA ниже от Теда D, после вопроса, который я разместил здесь. К сожалению, это не работает полностью:

• После того, как я вставил первое число (но не 0) в ячейку столбца B, все строки, которые имеют ноль в этом столбце, скрыты - и это здорово.

• Проблема в том, и, пожалуйста, извините, что я не упомянул об этом с самого начала, что каждый раз, когда я использую этот лист, несколько ячеек в столбце B должны быть заполнены числами больше 0. Таким образом, было бы очень полезно скрыть строки, которые содержат 0 в столбце B, после того, как я заполнил все остальные ячейки, которые мне нужны.

• Я думал, что, может быть, если есть условие - строки с 0 в столбце B будут скрыты только после заполнения определенной объединенной ячейки текстом? Я не знаю, возможно ли это, но у меня нет другой идеи.

Это VBA:

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

Большое спасибо за Вашу помощь!

Первоначальная ситуация была:

У меня есть лист с множеством формул, и мне нужно, чтобы это происходило: когда этот лист используется, и некоторые ячейки в разных строках заполнены числом, отличным от 0, строки, содержащие ячейки с 0, скрываются автоматически. И это должно происходить каждый раз, когда используется лист с разными значениями. О прикрепленном примере:

• Значение, которое изменяется, находится в столбце B

• D, E и F - объединенные ячейки в каждом ряду.

• Говоря о прикрепленном примере: мне нужно, чтобы строки с Text2, Text 4 и Text 5 были скрыты автоматически, потому что в столбце B значение этих строк равно нулю.

ВАЖНЫЙ! - при каждом использовании рабочего листа строки, имеющие 0 в столбце B, различаются. Не всегда одно и то же. Кроме того, эта автоматизация должна применяться только к определенному выделению в документе (скажем, от 45 до 135 строк).

Answer 1

Желаемое поведение может быть получено с помощью единовременных правок:

• Измените имя Sub с Worksheet_Calculate на Hide_Rows .
• Измените область действия Sub с Private на Public .
• Сохранить изменения.

Чтобы обновить скрытые строки:

• Внесите изменения в рабочий лист.
• Оставайтесь на листе скрытых рядов.
• Скройте строки, открыв диалог Macro, используя Alt - F8.
• Дважды щелкните (запустить) <sheetName>!Hide_Rows .

NB. В исходном ответе использовался модуль листа, специфичный для рабочего листа со скрытыми строками. Чтобы сделать запуск макроса доступным, когда это не активный лист, Sub (макрос) необходимо будет переместить в общий модуль. В этом случае необходимо внести дополнительные изменения в Sub Hide_Rows , чтобы активный лист не обрабатывался, а вместо этого конкретный рабочий лист со скрытыми строками фильтруется.

Answer 2

Я думаю, что было бы лучше просто попросить Теда внести изменения, комментируя его ответ.

Есть несколько способов сделать это, вы просто должны решить, как вы хотите, чтобы это работало.

При вводе числа 0 в документе могут быть скрыты строки:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ProcError
If Not Application.Intersect(Range(Target.Address), Range("B:B")) Is Nothing Then
    If Target.Value = "0" Then
        Target.EntireRow.Hidden = True
    End If
End If
ProcError:
End Sub

Вы можете использовать кнопку, чтобы вручную запустить макрос, скрывающий все строки.
(пример кода в универсальном цикле, медленнее исходного макроса)

Sub hideZero()
Dim searchMe As Range, zero As Range
Set searchMe = ActiveSheet.Range(Range("B2"), Range("B1048576").End(xlUp))
Application.ScreenUpdating = False
For Each zero In searchMe
    If zero.Value2 = 0 Then
        zero.EntireRow.Hidden = True
    End If
Next zero
Application.ScreenUpdating = True
End Sub

Это медленный код, и если у вас много строк, Excel на некоторое время зависнет.

Если вы хотите, чтобы ваше предложение «строки с 0 в столбце B было скрыто только после заполнения определенной объединенной ячейки текстом?»« Вы могли бы использовать первый подход с Worksheet_Change , но вместо этого отслеживать эту ячейку и запускать событие вместо кнопки:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim checkMe As Range
Set checkMe = Range("A1") 'Change to Wherever the cell is
On Error GoTo ProcError
If Not Application.Intersect(Range(Target.Address), checkMe) Is Nothing Then
    If Not Target.Value2 = "" Then
        Call hideZero
    End If
End If
ProcError:
End Sub

Хотя это может быть довольно неожиданным для конечного пользователя, запуск макросов без предупреждения. Таким образом, вы, вероятно, должны поставить предупреждение там. Вы можете сделать это, изменив If вызывающий сабвуфер:

If Not Target.Value2 = "" Then
    msgboxResult = MsgBox("Are you sure you want to continue?", vbExclamation + vbYesNo, "Warning!")
    If msgboxResult = vbYes Then Call hideZero
End If