Maal

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.

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