Notifications
Clear all

Procedure too large

4 Posts
3 Usuários
0 Reactions
1,149 Visualizações
kurkas
(@kurkas)
Posts: 85
Trusted Member
Topic starter
 

Bom dia,
Tenho um código que devolve cores dos Labels em função das datas encontradas na planilha.
São 85 Labels (Label, Label1, Label2, Label3..........)
Para cada um criei o código que passo a citar.
Como são 85 Labels, aparece-me a mensagem "Procedure too large".
Como faço para abreviar o código de forma a que ele corra?

Private Sub verifica_datas()
Set origem = Worksheets("CCT Normal").Range("A2:FG87")

'se ENTREGUE E DEVOLVIDO (BRANCO)
If WorksheetFunction.VLookup(CDbl(Label), origem, 163, False) <> "" Then
Label.BackColor = &H8000000F
End If
'se ENTREGUE MAS NÃO DEVOLVIDO (VERDE)
If WorksheetFunction.VLookup(CDbl(Label), origem, 162, False) >= Date And _
   WorksheetFunction.VLookup(CDbl(Label), origem, 163, False) = "" Then
Label.BackColor = &HFF00&
End If
'se ENTREGUE E EXPIRADO (VERMELHO)
If WorksheetFunction.VLookup(CDbl(Label), origem, 162, False) < Date And _
   WorksheetFunction.VLookup(CDbl(Label), origem, 163, False) = "" Then
Label.BackColor = &HFF&
End If
If WorksheetFunction.VLookup(CDbl(Label), origem, 7, False) = "" Then
Label.BackColor = &H8000000F
End If


'se ENTREGUE E DEVOLVIDO (BRANCO)
If WorksheetFunction.VLookup(CDbl(Label1), origem, 163, False) <> "" Then
Label1.BackColor = &H8000000F
End If
'se ENTREGUE MAS NÃO DEVOLVIDO (VERDE)
If WorksheetFunction.VLookup(CDbl(Label1), origem, 162, False) >= Date And _
   WorksheetFunction.VLookup(CDbl(Label1), origem, 163, False) = "" Then
Label1.BackColor = &HFF00&
End If
'se ENTREGUE E EXPIRADO (VERMELHO)
If WorksheetFunction.VLookup(CDbl(Label1), origem, 162, False) < Date And _
   WorksheetFunction.VLookup(CDbl(Label1), origem, 163, False) = "" Then
Label1.BackColor = &HFF&
End If
If WorksheetFunction.VLookup(CDbl(Label1), origem, 7, False) = "" Then
Label1.BackColor = &H8000000F
End If


'se ENTREGUE E DEVOLVIDO (BRANCO)
If WorksheetFunction.VLookup(CDbl(Label2), origem, 163, False) <> "" Then
Label2.BackColor = &H8000000F
End If
'se ENTREGUE MAS NÃO DEVOLVIDO (VERDE)
If WorksheetFunction.VLookup(CDbl(Label2), origem, 162, False) >= Date And _
   WorksheetFunction.VLookup(CDbl(Label2), origem, 163, False) = "" Then
Label2.BackColor = &HFF00&
End If
'se ENTREGUE E EXPIRADO (VERMELHO)
If WorksheetFunction.VLookup(CDbl(Label2), origem, 162, False) < Date And _
   WorksheetFunction.VLookup(CDbl(Label2), origem, 163, False) = "" Then
Label2.BackColor = &HFF&
End If
If WorksheetFunction.VLookup(CDbl(Label2), origem, 7, False) = "" Then
Label2.BackColor = &H8000000F
End If
 
Postado : 01/02/2017 4:05 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Uma rotina tem limite de linhas, tente quebrar a rotina em varias subrotinas...
Identifique o que é igual, e abstraia, ou faça 4 rotinas que atualizem 20 labels, cada...
O erro é claro: ROTINA MUITO GRANDE. Reduza o tamanho dela...

Quebre seus módulos.... há um limite de linhas para um módulo. também Quantas linhas tem o seu ? Quebre na metade em dois módulos, e provavelmente o erro sumirá !

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

 
Postado : 01/02/2017 5:13 am
leandroxtr
(@leandroxtr)
Posts: 447
Reputable Member
 

Crie dois módulos.
Um para buscar os dados com a função "VLookup" e outro para fazer a formatação com base no valor retornado.
Ai depois você chama das duas funções.

Ou...

Simplifique o código com a função "Case", que serve para trabalhar em cima da mesma referência em várias situações (aí você cria um Case para "Label1 e outra para Label2"). A função If Then não é muito adequada pra isso.

Ou...

Você pode usar If Then Elseif, que também resume bastante.

Espero que tenha ajudado!

Se te ajudou, não se esqueça de dar um like na resposta e marcar o tópico como finalizado.

Abraços!
Leandro Cordeiro

 
Postado : 01/02/2017 5:18 am
kurkas
(@kurkas)
Posts: 85
Trusted Member
Topic starter
 

Valeu. Resolvi.
Obrigado

 
Postado : 01/02/2017 6:55 am