Macro congela

[Maal]

Oi,

Tenho uma macro que oculta um conjunto de linhas e colunas quando se verifica determinada condição.

Acontece que na primeira execução esta tem um tempo de execução normal instantâneo, mas nas vezes seguintes ela congela levando mais de 30 segundos a executar.

Obrigado a todos desde já.

Sub OcultarRow_Col()
    Dim SomaColuna, ultimalinha, ultimacoluna, r, y As Integer
    
    Sheets("Diversos").Select
    ultimalinha = ActiveSheet.Range("V3")
    r = 0
    y = 0
    SomaColuna = 0
    ultimacoluna = 0

  '  Application.ScreenUpdating = False
  '  Application.Calculation = xlCalculationManual
    ' Oculta Linha
    For r = ultimalinha To 4 Step -1
       If Cells(r, 17) = 0 Then
          Rows(r).Hidden = True
       End If
    Next r
    
    If Cells(101, 5) + Cells(101, 6) + Cells(101, 7) + Cells(101, 8) = 0 Then
       Rows(101).Hidden = True
    End If
    If Cells(102, 5) + Cells(102, 6) + Cells(102, 7) + Cells(102, 8) = 0 Then
       Rows(102).Hidden = True
    End If
    If Cells(103, 5) + Cells(103, 6) + Cells(103, 7) + Cells(103, 8) = 0 Then
       Rows(103).Hidden = True
    End If
    If Cells(104, 5) + Cells(104, 6) + Cells(104, 7) + Cells(104, 8) = 0 Then
       Rows(104).Hidden = True
    End If
    If Cells(105, 5) + Cells(105, 6) + Cells(105, 7) + Cells(105, 8) = 0 Then
       Rows(105).Hidden = True
    End If
    If Cells(106, 5) + Cells(106, 6) + Cells(106, 7) + Cells(106, 8) = 0 Then
       Rows(106).Hidden = True
    End If
    If Cells(107, 5) + Cells(107, 6) + Cells(107, 7) + Cells(107, 8) = 0 Then
       Rows(107).Hidden = True
    End If
    If Cells(108, 5) + Cells(108, 6) + Cells(108, 7) + Cells(108, 8) = 0 Then
       Rows(108).Hidden = True
    End If
    If Cells(109, 5) + Cells(109, 6) + Cells(109, 7) + Cells(109, 8) = 0 Then
       Rows(109).Hidden = True
    End If
    If Cells(110, 5) + Cells(110, 6) + Cells(110, 7) + Cells(110, 8) = 0 Then
       Rows(110).Hidden = True
    End If
    If Cells(111, 5) + Cells(111, 6) + Cells(111, 7) + Cells(111, 8) = 0 Then
       Rows(111).Hidden = True
    End If
    If Cells(112, 5) + Cells(112, 6) + Cells(112, 7) + Cells(112, 8) = 0 Then
       Rows(112).Hidden = True
    End If
    If Cells(113, 5) + Cells(113, 6) + Cells(113, 7) + Cells(113, 8) = 0 Then
       Rows(113).Hidden = True
    End If
    If Cells(114, 5) + Cells(114, 6) + Cells(114, 7) + Cells(114, 8) = 0 Then
       Rows(114).Hidden = True
    End If
    If Cells(115, 5) + Cells(115, 6) + Cells(115, 7) + Cells(115, 8) = 0 Then
       Rows(115).Hidden = True
    End If
    If Cells(116, 5) + Cells(116, 6) + Cells(116, 7) + Cells(116, 8) = 0 Then
       Rows(116).Hidden = True
    End If
    If Cells(117, 5) + Cells(117, 6) + Cells(117, 7) + Cells(117, 8) = 0 Then
       Rows(117).Hidden = True
    End If
    If Cells(118, 5) + Cells(118, 6) + Cells(118, 7) + Cells(118, 8) = 0 Then
       Rows(118).Hidden = True
    End If
    If Cells(119, 5) + Cells(119, 6) + Cells(119, 7) + Cells(119, 8) = 0 Then
       Rows(119).Hidden = True
    End If
    If Cells(120, 5) + Cells(120, 6) + Cells(120, 7) + Cells(120, 8) = 0 Then
       Rows(120).Hidden = True
    End If
    If Cells(121, 5) + Cells(121, 6) + Cells(121, 7) + Cells(121, 8) = 0 Then
       Rows(121).Hidden = True
    End If
    
    r = 0
    y = 0
    SomaColuna = 0
    ultimalinha = 0
    ultimacoluna = 16
    ' Oculta coluna
    For r = ultimacoluna To 1 Step -1
       'soma Positivos
        If Cells(98, r) = 0 And r <> 12 Then
           Columns(r).Hidden = True
        Else
           If r = 12 Then
              SomaColuna = 0
              For y = 4 To 95 Step 1
                  SomaColuna = SomaColuna + Abs(Cells(y, 12))
              Next y
              If SomaColuna = 0 Then
                 Columns(12).Hidden = True
              End If
          End If
       End If
    Next r
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

[benzadeus]

Experimente trocar

' Application.ScreenUpdating = False

' Application.Calculation = xlCalculationManual

por

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Isto é, remover as aspas.

[Maal]

Experimente trocar

' Application.ScreenUpdating = False

' Application.Calculation = xlCalculationManual

por

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Isto é, remover as aspas.

Não resolve essas aspas foram colocas numa tentativa de resolução!

Obrigado pela ajuda.

PS: Peço desculpa só agora dar retorno, mas acontece que estive doente em casa.

[benzadeus]

A macro fica mais rápida se você armazenar todos os valores de linha numa variável e depois ocultá-las todas de uma vez:

Sub OcultarRow_Col()
    Dim SomaColuna, ultimalinha, ultimacoluna, r, y As Integer
    Dim rng As Range
    Dim lng As Long

    Sheets("Diversos").Select
    ultimalinha = ActiveSheet.Range("V3")
    r = 0
    y = 0
    SomaColuna = 0
    ultimacoluna = 0

      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
    ' Oculta Linha
    Set rng = Rows(1) 'rng não pode ser Nothing inicalmente senão um erro é retornado
    For r = ultimalinha To 4 Step -1
        If Cells(r, 17) = 0 Then
            Set rng = Union(rng, Rows(r))
        End If
    Next r
    rng.Hidden = True
    
    Set rng = Rows(1) 'rng não pode ser Nothing inicalmente senão um erro é retornado
    For lng = 101 To 121
        If Cells(lng, 5) + Cells(lng, 6) + Cells(lng, 7) + Cells(lng, 8) = 0 Then
            Set rng = Union(rng, Rows(lng))
        End If
    Next lng
    rng.Hidden = True

    r = 0
    y = 0
    SomaColuna = 0
    ultimalinha = 0
    ultimacoluna = 16
    ' Oculta coluna
    For r = ultimacoluna To 1 Step -1
        'soma Positivos
        If Cells(98, r) = 0 And r <> 12 Then
            Columns(r).Hidden = True
        Else
            If r = 12 Then
                SomaColuna = 0
                For y = 4 To 95 Step 1
                    SomaColuna = SomaColuna + Abs(Cells(y, 12))
                Next y
                If SomaColuna = 0 Then
                    Columns(12).Hidden = True
                End If
            End If
        End If
    Next r
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub