Início / coding / Perguntas / 79448708
Accepted
Ni Luh Sila Dewi
Asked: 2025-02-18 23:01:05 +0800 CST

Procedimento VBA muito grande

  • 772

Alguém poderia me ajudar a resolver meu problema relacionado ao erro Procedimento Muito Grande no VBA?

Estou usando Private Sub Worksheet_Calculate()para ocultar e exibir linhas automaticamente e há 275 células que eu gostaria de definir para os gatilhos. O exemplo abaixo é mostrado apenas para 10 células de gatilhos, e eu gostaria de criar 275 células de gatilhos

Fragmento de código

`Private Sub Worksheet_Calculate()

    Set iCell = Range("G38")
    Set iCell2 = Range("G70")
    Set iCell3 = Range("G102")
    Set iCell4 = Range("G134")
    Set iCell5 = Range("G166")
    Set iCell6 = Range("G198")
    Set iCell7 = Range("G230")
    Set iCell8 = Range("G262")
    Set iCell9 = Range("G294")
    Set iCell10 = Range("G326")

    Application.EnableEvents = False

      byFALSE1Hidden = Rows("38:68").Hidden
    byTRUE1Hidden = Rows("10000:10000").Hidden

    ' New logic for trigger 2
    byFALSE2Hidden = Rows("70:100").Hidden
    byTRUE2Hidden = Rows("10001:10001").Hidden

    ' New logic for trigger 3
    byFALSE3Hidden = Rows("102:132").Hidden
    byTRUE3Hidden = Rows("10002:10002").Hidden

    ' New logic for trigger 4
    byFALSE4Hidden = Rows("134:164").Hidden
    byTRUE4Hidden = Rows("10003:10003").Hidden

    ' New logic for trigger 5
    byFALSE5Hidden = Rows("166:196").Hidden
    byTRUE5Hidden = Rows("10004:10004").Hidden

    ' New logic for trigger 6
    byFALSE6Hidden = Rows("198:228").Hidden
    byTRUE6Hidden = Rows("10005:10005").Hidden

    ' New logic for trigger 7
    byFALSE7Hidden = Rows("230:260").Hidden
    byTRUE7Hidden = Rows("10006:10006").Hidden

    ' New logic for trigger 8
    byFALSE8Hidden = Rows("262:292").Hidden
    byTRUE8Hidden = Rows("10007:10007").Hidden

    ' New logic for trigger 9
    byFALSE9Hidden = Rows("294:324").Hidden
    byTRUE9Hidden = Rows("10008:10008").Hidden

    ' New logic for trigger 10
    byFALSE10Hidden = Rows("326:356").Hidden
    byTRUE10Hidden = Rows("10009:10009").Hidden

    
    If iCell.value = "FALSE1" Then
        If Not byFALSE1Hidden Then
            Rows("38:68").Hidden = True
            Rows("10000:10000").Hidden = False
        End If
    ElseIf iCell.value = "TRUE1" Then
        If Not byTRUE1Hidden Then
            Rows("38:68").Hidden = False
            Rows("10000:10000").Hidden = True
         End If
    End If

'   New logic for trigger 2
    If iCell2.value = "FALSE2" Then
        If Not byFALSE2Hidden Then
            Rows("70:100").Hidden = True
            Rows("10001:10001").Hidden = False
        End If
    ElseIf iCell2.value = "TRUE2" Then
        If Not byTRUE2Hidden Then
            Rows("70:100").Hidden = False
            Rows("10001:10001").Hidden = True
         End If
    End If

'   New logic for trigger 3
    If iCell3.value = "FALSE3" Then
        If Not byFALSE3Hidden Then
            Rows("102:132").Hidden = True
            Rows("10002:10002").Hidden = False
        End If
    ElseIf iCell3.value = "TRUE3" Then
        If Not byTRUE3Hidden Then
            Rows("102:132").Hidden = False
            Rows("10002:10002").Hidden = True
         End If
    End If

'   New logic for trigger 4
    If iCell4.value = "FALSE4" Then
        If Not byFALSE4Hidden Then
            Rows("134:164").Hidden = True
            Rows("10003:10003").Hidden = False
        End If
    ElseIf iCell4.value = "TRUE4" Then
        If Not byTRUE4Hidden Then
            Rows("134:164").Hidden = False
            Rows("10003:10003").Hidden = True
         End If
    End If

'   New logic for trigger 5
    If iCell5.value = "FALSE5" Then
        If Not byFALSE5Hidden Then
            Rows("166:196").Hidden = True
            Rows("10004:10004").Hidden = False
        End If
    ElseIf iCell5.value = "TRUE5" Then
        If Not byTRUE5Hidden Then
            Rows("166:196").Hidden = False
            Rows("10004:10004").Hidden = True
         End If
    End If

'   New logic for trigger 6
    If iCell6.value = "FALSE6" Then
        If Not byFALSE6Hidden Then
            Rows("198:228").Hidden = True
            Rows("10005:10005").Hidden = False
        End If
    ElseIf iCell6.value = "TRUE6" Then
        If Not byTRUE6Hidden Then
            Rows("198:228").Hidden = False
            Rows("10005:10005").Hidden = True
         End If
    End If

'   New logic for trigger 7
    If iCell7.value = "FALSE7" Then
        If Not byFALSE7Hidden Then
            Rows("230:260").Hidden = True
            Rows("10006:10006").Hidden = False
        End If
    ElseIf iCell7.value = "TRUE7" Then
        If Not byTRUE7Hidden Then
            Rows("230:260").Hidden = False
            Rows("10006:10006").Hidden = True
         End If
    End If

'   New logic for trigger 8
    If iCell8.value = "FALSE8" Then
        If Not byFALSE8Hidden Then
            Rows("262:292").Hidden = True
            Rows("10007:10007").Hidden = False
        End If
    ElseIf iCell8.value = "TRUE8" Then
        If Not byTRUE8Hidden Then
            Rows("262:292").Hidden = False
            Rows("10007:10007").Hidden = True
         End If
    End If

'   New logic for trigger 9
    If iCell9.value = "FALSE9" Then
        If Not byFALSE9Hidden Then
            Rows("294:324").Hidden = True
            Rows("10008:10008").Hidden = False
        End If
    ElseIf iCell9.value = "TRUE9" Then
        If Not byTRUE9Hidden Then
            Rows("294:324").Hidden = False
            Rows("10008:10008").Hidden = True
         End If
    End If

'   New logic for trigger 10
    If iCell10.value = "FALSE10" Then
        If Not byFALSE10Hidden Then
            Rows("326:356").Hidden = True
            Rows("10009:10009").Hidden = False
        End If
    ElseIf iCell10.value = "TRUE10" Then
        If Not byTRUE10Hidden Then
            Rows("326:356").Hidden = False
            Rows("10009:10009").Hidden = True
         End If
    End If


    Application.EnableEvents = True

End Sub

Obrigado.

excel

2 respostas

  1. Option Explicit

Private Sub Worksheet_Calculate()
    Application.EnableEvents = False

    HideShow "FALSE1", 38, 68, "TRUE1", 10000 ' trigger 1
    HideShow "FALSE2", 70, 100, "TRUE2", 10001 ' trigger 2
    HideShow "FALSE3", 102, 132, "TRUE3", 10002 ' trigger 3
    HideShow "FALSE4", 134, 164, "TRUE4", 10003 ' trigger 4
    HideShow "FALSE5", 166, 196, "TRUE5", 10004 ' trigger 5
    HideShow "FALSE6", 198, 228, "TRUE6", 10005  ' trigger 6
    HideShow "FALSE7", 230, 260, "TRUE7", 10006  ' trigger 7
    HideShow "FALSE8", 262, 292, "TRUE8", 10007 ' trigger 8
    HideShow "FALSE9", 294, 324, "TRUE9", 10008 ' trigger 9
    HideShow "FALSE10", 326, 356, "TRUE10", 10009 ' trigger 10
    
    Application.EnableEvents = True
End Sub

Sub HideShow(sFalse As String, r1start As Long, r1end As Long, sTrue As String, r2 As Long)
     
    Dim rng1 As Range, rng2 As Range
    Set rng1 = Rows(r1start).Resize(r1end - r1start + 1)
    Set rng2 = Rows(r2)
     
    If Cells(r1start, "G").Value = sFalse Then
        If rng1.Hidden = False Then
            rng1.Hidden = True
            rng2.Hidden = False
        End If
    ElseIf Cells(r1start, "G").Value = sTrue Then
        If rng2.Hidden = False Then
            rng1.Hidden = False
            rng2.Hidden = True
         End If
    End If
  
End Sub

    Se você tiver 275 valores, coloque-os em 5 colunas em outra planilha (oculta) como esta

    FALSE1   38   68  TRUE1   10000
FALSE2   70  100  TRUE2   10001
FALSE3  102  132  TRUE3   10002
FALSE4  134  164  TRUE4   10003
FALSE5  166  196  TRUE5   10004
FALSE6  198  228  TRUE6   10005
FALSE7  230  260  TRUE7   10006
FALSE8  262  292  TRUE8   10007
FALSE9  294  324  TRUE9   10008
FALSE10 326  356  TRUE10  10009

    e então o código se torna

    Private Sub Worksheet_Calculate()
    Dim ar As Variant
    Dim r As Long, r1start As Long, r1end As Long, r2 As Long
    Dim sFalse As String, sTrue As String
    
    ar = Sheets("Sheet2").Range("A1:E275").Value

    Application.EnableEvents = False
    For r = 1 To UBound(ar)
        sFalse = CStr(ar(r, 1))
        r1start = CLng(ar(r, 2))
        r1end = CLng(ar(r, 3))
        sTrue = CStr(ar(r, 4))
        r2 = CLng(ar(r, 5))
        Call HideShow(sFalse, r1start, r1end, sTrue, r2)
    Next
    Application.EnableEvents = True
End Sub
    • 1
  2. Best Answer

    Você pode encurtar o sub usando o ciclo:

    Option Explicit
Option Base 1

Private Sub Worksheet_Calculate()
  Dim aTrue, aFalse, i&, k&, n&
  aTrue = Array("TRUE1", "TRUE2", "TRUE3", "TRUE4", "TRUE5", "TRUE6", "TRUE7", "TRUE8", "TRUE9", "TRUE10")
  aFalse = Array("FALSE1", "FALSE2", "FALSE3", "FALSE4", "FALSE5", "FALSE6", "FALSE7", "FALSE8", "FALSE9", "FALSE10")
  Application.EnableEvents = False
  For i = 1 To UBound(aTrue)
    k = 6 + 32 * i: n = 9999 + i
    If Cells(k, "G").Value = aFalse(i) And Not Rows(k).Hidden Then
      Rows(k & ":" & (30 + k)).Hidden = True
      Rows(n).Hidden = False
    End If
    With Rows(n)
      If Cells(k, "G").Value = aTrue(i) And Not .Hidden Then
        Rows(k & ":" & (30 + k)).Hidden = False
        .Hidden = True
      End If
    End With
  Next
  Application.EnableEvents = True
End Sub

    Para "algum número diferente de lacunas nos gatilhos", use:

      Dim aNumbers, j&
  j = UBound(aTrue)
  ReDim aNumbers(j)
  ' Generate the regular sequence
  For i = 1 To j
    aNumbers(i) = 6 + 32 * i
  Next
  ' Substitute some numbers
  aNumbers(3) = 11
  aNumbers(7) = 22
  ...
      If Cells(aNumbers(i), "G").Value = aFalse(i) Then
  ...
    • 0

relate perguntas