Как автоматизировать выполнение этого макроса?

Question

Sub HURows()
    Dim BeginRows() As Variant
    Dim EndRows() As Variant
    ChkCol = 6

    BeginRows = Array(12, 20, 26, 36, 43, 51, 60, 72, 79)
    EndRows = Array(15, 21, 31, 38, 46, 55, 67, 74, 81)

    For Index = 0 To UBound(BeginRows)
        For RowCnt = BeginRows(Index) To EndRows(Index)
            If Cells(RowCnt, ChkCol).Value = 0 Then
                Cells(RowCnt, ChkCol).EntireRow.Hidden = True
            Else
                Cells(RowCnt, ChkCol).EntireRow.Hidden = False
            End If
        Next RowCnt
    Next Index
End Sub

У меня есть этот макрос ниже, но мне нужно, чтобы он выполнялся автоматически вместо перехода на вкладку «Разработчик» и нажатия «Выполнить». Есть ли способ сделать это, например, добавить строку инструкции к существующему макросу ниже?

Answer 1

Сделайте первый лист активным и нажмите Alt + F11, чтобы открыть соответствующую область кода листа ...

После того, как вы откроете этот код, поместите на него

'This is the event that will trigger when some cell is changed on the sheet
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 Then ' If the target column is the second one
        Select Case Target.Row
            Case 12 To 15, 20 To 21, 26 To 31, 36 To 38, 43 To 46, 51 To 55, 60 To 67, 72 To 74, 79 To 81
            'If target row that is being change is the ones referenced on the case
                Dim targetSheet As Worksheet ' We need to reference the target sheet you desire
                Set targetSheet = Worksheets("Folha2") 'Change the Sheet2 to the name of your target sheet
                If Trim(Target.Value) = 0 Then ' If the value of the cell is 0
                    targetSheet.Cells(Target.Row, 1).EntireRow.Hidden = True ' Set the target sheet row to hidden
                    MsgBox "hidden"
                ElseIf Trim(Target.Value) > 0 Then 'If the value is superior to 0
                    targetSheet.Cells(Target.Row, 1).EntireRow.Hidden = False ' Set the target sheet row to not hidden
                    MsgBox "un-hidden"
                End If ' Close the second if statement
        End Select
    End If ' Close the firts if statement
End Sub ' Close the sub routine

Пожалуйста, сохраняйтепомните, чтобы изменить имя вкладки Sheet2 на ваше имя листа.