Notifications
Clear all

Código Lento

4 Posts
2 Usuários
0 Reactions
1,117 Visualizações
 guma
(@guma)
Posts: 135
Estimable Member
Topic starter
 

Boa Tarde
Tem como simplificar o Código a Baixo ???

Sub Dropdown493_Alteração()
Application.ScreenUpdating = False
Columns("A:HL").EntireColumn.Hidden = False
Dim LC As Long, k As Long

LC = Cells(4, Columns.Count).End(xlToLeft).Column

For k = 4 To LC
    If Cells(4, k) <> Range("B3") Then
        Columns(k).EntireColumn.Hidden = True
    End If
Next k

Application.ScreenUpdating = True
End Sub

O mesmo é relativamente simples, mas demora pacas.
Ou o problema não está no código???

Obrigado

 
Postado : 04/06/2013 2:23 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não saco muito mas parece que pode ser o "Hidden" a cada k. Deixo pra galera.

Abs,

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 04/06/2013 2:27 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde guma,

Não sei porque está lerdo, mas vê se ajuda:

Option Explicit

Sub Dropdown493_Alteração()
Dim LC  As Long
Dim k   As Long
Dim Ws  As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlManual

Columns("A:HL").EntireColumn.Hidden = False
LC = Cells(4, Columns.Count).End(xlToLeft).Column
Set Ws = Worksheets("Plan1")

    For k = 4 To LC
        If Ws.Cells(4, k) <> Ws.Range("B3") Then
            Columns(k).EntireColumn.Hidden = True
        End If
    Next k

Set Ws = Nothing

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 04/06/2013 2:48 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Eu fiz um teste com 5000 linhas e mais de 30 colunas, eu não tive problema!!

Repare que fiz uma micro mudança na rotina!

Sub Teste_AleVBA()
Dim LC As Long, k As Long

Application.ScreenUpdating = False
'Columns("A:HL").EntireColumn.Hidden = False

LC = Cells(4, Columns.Count).End(xlToLeft).Column

For k = 4 To LC
    If Cells(4, k) <> Range("B3") Then
        Columns(k).EntireColumn.Hidden = True
    End If
Next k

Application.ScreenUpdating = True
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 04/06/2013 4:43 pm