Notifications
Clear all

OTIMIZAR ROTINA

21 Posts
2 Usuários
0 Reactions
2,332 Visualizações
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Ola Pessoal,

O código abaixo eu criei para validar alguns Options Buttons, mas a título de estudo gostaria de saber se existe uma forma de OTIMIZAR a rotina, pois acho que me faltou habilidade ao escrevê-la.

Desde ja agradeço quem puder colaborar

Sub FILTdNS()

Dim Linha As Double
Dim VORCA As Double

Sheets("DNS").Activate

Linha = 1
VORCA = TextBox40

With Sheets("DNS")
    
    Do While .Cells(Linha, "A").Value <> ""
    
    'parte 1
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 18 Then
    CH18 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 17 Then
    CH17 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 16 Then
    CH16 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 15 Then
    CH15 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 14 Then
    CH14 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 13 Then
    CH13 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 12 Then
    CH12 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 11 Then
    CH11 = True
    End If
    
    'parte 2
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 21 Then
    CH21 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 22 Then
    CH22 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 23 Then
    CH23 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 24 Then
    CH24 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 25 Then
    CH25 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 26 Then
    CH26 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 27 Then
    CH27 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 28 Then
    CH28 = True
    End If
    
    
    'parte 3
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 48 Then
    CH48 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 47 Then
    CH47 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 46 Then
    CH46 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 45 Then
    CH45 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 44 Then
    CH44 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 43 Then
    CH43 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 42 Then
    CH42 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 41 Then
    CH41 = True
    End If
    
    
    'parte 4
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 31 Then
    CH31 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 32 Then
    CH32 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 33 Then
    CH33 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 34 Then
    CH34 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 35 Then
    CH35 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 36 Then
    CH36 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 37 Then
    CH37 = True
    End If
    
    If Sheets("DNS").Range("B" & Linha) = VORCA And Sheets("DNS").Range("A" & Linha) = 38 Then
    CH38 = True
    End If
       
    Linha = Linha + 1
    Loop
    End With

End Sub
 
Postado : 19/04/2015 8:54 pm
(@edcronos)
Posts: 1006
Noble Member
 

primeiro
vc usou
Sheets("DNS").Activate
isso garante que vai estar na aba dns

então não era nescessario usar
if Sheets("DNS").Range(
apenas
if Range(

segundo
With Sheets("DNS")
a mesma coisa,
não teria nessecidade de usar se vc não está tentando passar ou comparar dados de uma planilha para outra e já usou Sheets("DNS").Activate

mas se fosse o caso
era só usar
if .Range(
um ponto antes de cells ou range

mas basicamente
If Range("B" & Linha) = VORCA And Range("A" & Linha) = 18 Then
CH18 = True
End If

eu poderia falar para fazer um loop e usar apenas uma linha de comando com if
mas eu não sei se esse objeto pode ser referenciado
tbm não sei se seguem contagem sequencial

se estiver em um userform
pode tentar assim

For N = 18 To 28
If Range("B" & Linha) = VORCA And Range("A" & Linha) = N Then
Control("CH" & N) = True
End If
Next

se for objeto em planilha peço desculpas não poder ajudar
mas tbm não entendi muito do seu codigo
o certo seria uma plan de exemplo "pelo menos para mim "

 
Postado : 19/04/2015 9:38 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Suas observações ja foram excelentes Ed.

Eu to tentando deixar minhas rotinas mais enxutas e se possível mais rápidas, mas para isso preciso aprender um bocado mais.

A rotina em questão esta em um USERFORM sim, já sobre o Loop que você mencionou eu não fiz porque não sabia como fazer já que não segue uma sequência exata. Os OPTIONS BUTTONS seguem a seguinte sequencia:

Parte 1- 18 a 11
Parte 2- 21 a 28
Parte 3- 48 a 41
Parte 4- 31 a 38

Vou ver se coloco um modelo, mas suas dicas ja forma bem esclarecedoras, principalmente sobre o Loop que eu tava meio perdidão, já que a sequencia é meio bagunçada. Mas seguindo sua ideia eu ja consigo reduzir com o Loop aquele tanto de linha com comando IF para apenas 4.

Valeu ;-)

 
Postado : 19/04/2015 11:24 pm
(@edcronos)
Posts: 1006
Noble Member
 

então basicamente vc pode tentar assim

Line = Cells(Rows.Count, "A").End(xlUp).Row ' acha a ultima linha preenchida da coluna A, daí vc faz a varredura para cima

if cells(line,"B")value= VORCA Then 'verifica se a coluna b tem o valor que vc quer "vorca"

vL = cells(line, "A").value2 'se col B tiver o valor pega o valor da coluna A
opt= "CH" & vL 'junta para formar o nome do objeto

If TypeOf control( opt) Is OptionButton Then 'verifica se nome de objeto existe
control( opt) = true ' se existir deixa como true
end if
end if

line=line-1

 
Postado : 20/04/2015 4:48 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Valeu pela dica, Ed. Mas com essa rotina ai gera erro. Acho que até entendi a rotina, mas parece que precisa declarar control de alguma forma. Pensei em declarar como uma variável comum, mas não deu.

Bom, conforme voce pediu to colocando um modelo em anexo. Se tiver um tempinho depois dá uma olhada. Valeu

 
Postado : 22/04/2015 2:58 pm
(@edcronos)
Posts: 1006
Noble Member
 

desculpe
Me.Controls(

escrevi errado
vou dar uma olhada no arquivo

 
Postado : 22/04/2015 3:24 pm
(@edcronos)
Posts: 1006
Noble Member
 

cara levei um tempão aqui mas acabou que tive que criar uma função para verificar se o objeto existe pq tudo o mais que tentei deu erro

ao que parece deu certo, mas não entendi a logica da sua planilha em relação ao formulario

Sub FILTdNS()

    Dim chx As Object
    Sheets("DNS").Activate
    Dim VORCA As Double
    VORCA = TextBox40.Value
    For c = 1 To 50

        If Existeobject("CH" & c, "CheckBox") = 1 Then
            Me.Controls("CH" & c).Value = False
        End If
    Next c

    Line = Cells(Rows.Count, "A").End(xlUp).Row    '
    For ch = 1 To Line
        If Cells(Line, "B").Value = VORCA Then  '

            vL = Cells(Line, "A").Value2
            opt = "CH" & vL
            If Existeobject(opt, "CheckBox") = 1 Then
                Me.Controls(opt).Value = True
            End If
        End If
    Next

End Sub
    Function Existeobject(nomeMS, tipoMS)
    Dim objg As MSForms.control
        For Each objg In Me.Controls
        If TypeName(objg) = tipoMS Then
                   If objg.Name = nomeMS Then Existeobject = 1: Exit Function
        End If
    Next objg
    Existeobject = 0
    End Function
 
Postado : 22/04/2015 4:38 pm
(@edcronos)
Posts: 1006
Noble Member
 

eu errei numa variavel eu coloquei line em vez de ch
mas as numerações dos seus checkbox não corresponde com a numeração que aparece,
po isso não estava entendendo a logica

Sub FILTdNS()
    Sheets("DNS").Activate
    Dim VORCA As Long
    VORCA = TextBox40
    
    For c = 1 To 50
        If Existeobject("CH" & c, "CheckBox") = 1 Then Controls("CH" & c).Value = False
    Next c

    Line = Cells(Rows.Count, 1).End(xlUp).Row    '
    
    For ch = 1 To Line
    
        If VORCA = Cells(ch, 2).Value2 Then  '

            opt = "CH" & Cells(ch, 1).Value2
            
            If Existeobject(opt, "CheckBox") = 1 Then Me.Controls(opt) = True

        End If
    Next

End Sub

 
Postado : 22/04/2015 5:27 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

rapaz....eu tava aqui moendo o cérebro pra entender o que eu estava fazendo errado, antes de dar uma resposta aleatória qualquer... :D

Vou fazer uns testes e dou uma resposta mais completa.

Valeu

 
Postado : 22/04/2015 5:38 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Ed agora sim, PERFECTO !

OS Check seguem uma ordem de próteses (ou falta de ordem..).

Mas enfim, a rotina ficou muito mais enxuta, mas eu pensei que diminuindo a rotina o desempenho também iria melhorar. No entanto, com o código antigo que eu usava ou com essa sua rotina o desempenho é lento.

Na parte abaixo eu precisei modificar um pouco, ate pra tentar deixar mais rápido.

For c = 1 To 50
        If Existeobject("CH" & c, "CheckBox") = 1 Then Controls("CH" & c).Value = False
    Next c

Usei o FOR associado a variável LINE na tentativa de melhorar o desempenho. E embora tenha melhorado um pouco ainda esta bastante lento. Provavelmente a rotina irá percorrer cerca de 10 mil linhas, e com testes realizado com essa quantidade de dados realmente o resultado final não é razoável.

Mas de qualquer forma ja agradeço imensamente por me ensinar uma forma de reduzir aquele código gigante que criei.

Abraço

 
Postado : 22/04/2015 7:36 pm
(@edcronos)
Posts: 1006
Noble Member
 

olha o tamanho da macro não quer dizer que vai rodar mais rapido
tem varios fatores envolvidos

quantidade de dados
formato da planilha
se tem formulas e formatações ou dependencias...

vc pode melhorar a velocidade de varias maneira,
usando array
usando linhas como essas

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

mas tudo depende de um conjunto
vc não falou em quantidade de dados ou velocidade da macro
então eu apenas me foquei em enjugar o codigo e deixar mais facil escrever

 
Postado : 22/04/2015 7:43 pm
(@edcronos)
Posts: 1006
Noble Member
 

testa se melhora a velocidade

Sub FILTdNS()
    Sheets("DNS").Activate
    Dim VORCA As Long, coluno() As Variant
    VORCA = TextBox40
    For c = 1 To 50
        If Existeobject("CH" & c, "CheckBox") = 1 Then Controls("CH" & c).Value = False
    Next c
    
    Line = Cells(Rows.Count, 1).End(xlUp).Row    '
coluno = Range("A2:B" & Line).Value2

    For ch = 1 To Line - 1
        If VORCA = coluno(ch, 2) Then '
            opt = "CH" & coluno(ch, 1)
            If Existeobject(opt, "CheckBox") = 1 Then Me.Controls(opt) = True

        End If
    Next

End Sub
 
Postado : 22/04/2015 7:55 pm
(@edcronos)
Posts: 1006
Noble Member
 

se não melhorar vai ter que criar uma lista de nomes dos objetos

mas o melhor seria deixar a numeração deles de forma continua
assim iria direto para o objeto em questão sem ter que ficar verificando a compatibilidade do valor com todos os objetos existentes no userform

 
Postado : 22/04/2015 8:07 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Foi mal Ed, é que só tenho como testar com os dados reais aqui no serviço. Eu não tenho permissão de copiar a planilha, ai faço apenas simulações dela quando estou em casa.

A alternativa que você deu melhorou um pouco, mas mesmo assim ainda fica pesado. Sobre criar lista com o nome dos objetos seria declarar cada um como variável ou criar uma coleção deles ?

A numeração eu não posso alterar, pois são numerações de próteses dentárias e isso é uma padronização internacional. Seria assim:

18-17-16-15-14-13-12-11
21-22-23-24-25-26-27-28
48-47-46-45-44-43-42-41
31-32-33-34-35-36-37-38

 
Postado : 23/04/2015 2:36 pm
(@edcronos)
Posts: 1006
Noble Member
 

olha
se é um padrão não tem como colocar outro valor na celula certo?
portanto vc pode ir direto sem verificar o objeto
já que outro valor seria erro de preenchimento, eu coloquei com verificação para evitar falhas

troque essa linha
If Existeobject(opt, "CheckBox") = 1 Then Me.Controls(opt) = True

por essa
Me.Controls(opt) = True

isso vai tirar uma carga de verificação a cada valor encontrado

se ainda assim ficar pesado vc tem que vericar outras coisas nisso aí,
outras coisas agarrando a macro
pc, memoria, versão excel

pq já está usando array
e 12 mil linhas em 2 colunas apenas seria instantâneo
sem falar que é apenas leitura

 
Postado : 23/04/2015 3:13 pm
Página 1 / 2