Este fórum está sendo desativado

[yanrichardd]

Boa tarde, eu tenho uma macro que atualiza 2 celulas a maxima e a minima a partir de uma celula que recebe um LINK RTD que fica atualizando em tempo real.


If Range("AA11").Value > Range("Z11").Value Then
Range("AA11").Value =Range("AA11").Value
Else
Range("AA11").Value = Range("Z11").Value
End If

If Range("AB11").Value < Range("Z11").Value Then
Range("AB11").Value = Range("AB11").Value
Else
Range("AB11").Value = Range("Z11").Value
End If
Application.OnTime Now + TimeValue("00:00:01"), "MaiorMenor"

No caso "Z11" é o LINK RTD que fica alterando todo segundo, AA11 a MAX, AB11 a MIN.

Porém esse método que eu uso fica rodando a macro todo segundo e com isso as vezes ele perde algum frame e trava alguma outra macro que é chamada em determinada hora. Alguém tem alguma ideia para eu melhorar isso?

Obrigado!

[Jimmy]

Olá,

Não sei sobre o problema de travamento pois teria que ver o sistema todo, mas caso você tenha um botão para iniciar a macro, ele só deve ser acionado 1 vez só. Se o operador acionar a segunda, vai executar uma segunda macro periódica, logo, serão executadas 2 vezes por segundo. Se ele acionar o botão 10 vezes, por exemplo, a cada segundo serão executadas 10 macros, até que a planilha seja fechada. Se o acionamento estiver sendo feito manualmente, estude o caso de acionar a macro no OPEN da planilha, e não disponibilizar botão para acionamento manual.

Do fragmento de macro que você postou, posso comentar que isto

Código: Selecionar todos

If Range("AA11").Value > Range("Z11").Value Then
Range("AA11").Value =Range("AA11").Value
Else
Range("AA11").Value = Range("Z11").Value
End If

If Range("AB11").Value < Range("Z11").Value Then
Range("AB11").Value = Range("AB11").Value
Else
Range("AB11").Value = Range("Z11").Value
End If

é igual a isto

Código: Selecionar todos

If Range("AA11").Value < Range("Z11").Value Then Range("AA11").Value = Range("Z11").Value
If Range("AB11").Value > Range("Z11").Value Then Range("AB11").Value = Range("Z11").Value

Jimmy

[yanrichardd]

Obrigado pela resposta Jimmy, sou novo no assunto. O que acontece, é que as vezes eles não executam no timing certo. Por exemplo quando ele vai rodar o sexto passo, ele insere o dado com o valor zerado ao invés do valor coletado.
Também tinha pensado se é possivel fazer isso na própria celula ao invés de usando VBA.(A maxima e a minima da celula que muda o seu valor).
Segue abaixo o resto dos procedimentos, passo a passo.

Primeiro passo (assim que eu começo a trabalhar)

Código: Selecionar todos

If Range("AA11").Value < Range("Z11").Value Then Range("AA11").Value = Range("Z11").Value
If Range("AB11").Value > Range("Z11").Value Then Range("AB11").Value = Range("Z11").Value
Application.OnTime Now + TimeValue("00:00:01"), "MaiorMenor"

Segundo passo (toda hora cheia a cada 15 minutos esse procedimento vai ser chamado, 10:15,10:30,10:45,11:00....)

Código: Selecionar todos

Range("Z3").Value = Range("Z11").Value
Range("AA11").Value = "3"
Range("AB11").Value = "99"

Código: Selecionar todos

Application.OnTime TimeValue("10:15:00"), "zera"
Application.OnTime TimeValue("10:30:00"), "zera"
Application.OnTime TimeValue("10:45:00"), "zera"
Application.OnTime TimeValue("11:00:00"), "zera"

Terceiro Passo (10:14, 10:29, 10:44, 10:58...) salvo isso pois preciso salvar a primeira cotação num período de tempo (abertura).

Código: Selecionar todos

Range("AB3").Value = Range("Z3").Value

Código: Selecionar todos

Application.OnTime TimeValue("10:14:00"), "refatt"
Application.OnTime TimeValue("10:29:00"), "refatt"
Application.OnTime TimeValue("10:44:00"), "refatt"
Application.OnTime TimeValue("10:59:00"), "refatt"

Quarto Passo: (10:14:59,10:29:59,10:44:59,10:59:59...) Também tenho um problema com o que está em negrito, que as vezes ele cria mais de uma vez a mesma linha com valores duplicados.

Código: Selecionar todos

Range("Z9").Value = Range("Z11").Value
    Range("Z5").Value = Range("AA11").Value 
      Range("Z7").Value = Range("AB11").Value 

Quinto Passo (aqui todos os valores desses 14 minutos e 59 segundos estão salvos e o primeiro passo excecuta novamente, zerando todos os valores anteriormente coletados.)

Sexto Passo (salvo as informações coletadas na planilha. 10:15:01, 10:30:01, 10:46:01, 11:00:01...

Código: Selecionar todos

 Rows("13:13").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Range("G14:BE14").Select
    Selection.AutoFill Destination:=Range("G13:BE14"), Type:=xlFillDefault
    Range("G13:BE14").Select
    ActiveWindow.LargeScroll ToRight:=-1
    Range("Z11").Select
   
  Range("B13") = Range("AB3").Value
  Range("C13") = Range("Z5").Value
    Range("D13") = Range("Z7").Value
    Range("E13") = Range("Z9").Value

     Range("V13") = Date
If Range("V13") <> Range("V14") Then

   Range("W13") = "10"
  Range("X13") = "0"
    
    Else
    
    
Range("X14") = "0" Then
 
    Range("X13") = "15"
   
End If

    
  Range("X14") = "15" Then
 
    Range("X13") = "30"
 
    
 End If
 
    
   Range("X14") = "30" Then
 
    Range("X13") = "45"
    
End If

   Range("X14") = "45" Then
    
   Range("W13") = Range("W14") + "1"
    Range("X13") = "0"
    
    Else
    
    Range("W13") = Range("W14")
    
End If


End If


  If Range("B13") = Range("B14") And Range("C13") = Range("C14") And Range("D13") = Range("D14") And Range("E13") = Range("E14") Then
   
    Rows(13).Delete
    
   End If

Código: Selecionar todos

Application.OnTime TimeValue("10:15:01"), "novacelula"
Application.OnTime TimeValue("10:30:01"), "novacelula"
Application.OnTime TimeValue("10:45:01"), "novacelula"
Application.OnTime TimeValue("11:00:01"), "novacelula"

e também tenho um problema que ele cria a mesma linha mais de uma vez, por isso adicionei isso

Código: Selecionar todos

  If Range("B13") = Range("B14") And Range("C13") = Range("C14") And Range("D13") = Range("D14") And Range("E13") = Range("E14") Then
   
    Rows(13).Delete

[Jimmy]

Verifique se nas macros "zera", "refatt" e "novacelula" tem uma linha de auto-acionamento, como
Application.OnTime Now + TimeValue("...

Eu acho que você deveria ter uma única macro que roda periodicamene (a cada 1 segundo, no seu caso), e ela, de acordo com a hora, aciona as demais macros. Ela seria a gerenciadora das ações.

Para ter uma ideia melhor do todo, você teria que colocar as macros, desde o SUB até o END SUB.

Jimmy San Juan

[yanrichardd]

Jimmy, obrigado pela paciencia. Aqui segue todos os códigos que possuo na minha planilha. A sub "junto" é o que eu utilizo para rodar.

Código: Selecionar todos

Sub MaiorMenor()

If Range("AA11").Value < Range("Z11").Value Then Range("AA11").Value = Range("Z11").Value
If Range("AB11").Value > Range("Z11").Value Then Range("AB11").Value = Range("Z11").Value
Application.OnTime Now + TimeValue("00:00:01"), "MaiorMenor"
End Sub

Código: Selecionar todos

Sub zeramaxima()

Range("Z3").Value = Range("Z11").Value
Range("AA11").Value = "3"
Range("AB11").Value = "99"

End Sub

Código: Selecionar todos

Sub callzeramaxima()

Application.OnTime TimeValue("10:00:00"), "zeramaxima"
Application.OnTime TimeValue("10:15:00"), "zeramaxima"
Application.OnTime TimeValue("10:30:00"), "zeramaxima"
Application.OnTime TimeValue("10:45:00"), "zeramaxima"

End Sub

Código: Selecionar todos

Sub refatt()
Range("AB3").Value = Range("Z3").Value

End Sub

Código: Selecionar todos

Sub callrefatt()

Application.OnTime TimeValue("10:14:00"), "refatt"
Application.OnTime TimeValue("10:29:00"), "refatt"
Application.OnTime TimeValue("10:44:00"), "refatt"
Application.OnTime TimeValue("10:59:00"), "refatt"

End Sub

Código: Selecionar todos

Sub Tdjunto()
Range("Z9").Value = Range("Z11").Value
    Range("Z5").Value = Range("AA11").Value 
      Range("Z7").Value = Range("AB11").Value

End Sub

Código: Selecionar todos

Sub calltdjunto()
Application.OnTime TimeValue("10:14:59"), "tdjunto"
Application.OnTime TimeValue("10:29:59"), "tdjunto"
Application.OnTime TimeValue("10:44:59"), "tdjunto"
Application.OnTime TimeValue("10:59:59"), "tdjunto"
End sub

Código: Selecionar todos

Sub novacelula()
Rows("13:13").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Range("G14:BE14").Select
    Selection.AutoFill Destination:=Range("G13:BE14"), Type:=xlFillDefault
    Range("G13:BE14").Select
    ActiveWindow.LargeScroll ToRight:=-1
    Range("Z11").Select
   
  Range("B13") = Range("AB3").Value
  Range("C13") = Range("Z5").Value
    Range("D13") = Range("Z7").Value
    Range("E13") = Range("Z9").Value

     Range("V13") = Date
If Range("V13") <> Range("V14") Then

   Range("W13") = "10"
  Range("X13") = "0"
    
    Else
    
    
Range("X14") = "0" Then
 
    Range("X13") = "15"
   
End If

    
  Range("X14") = "15" Then
 
    Range("X13") = "30"
 
    
 End If
 
    
   Range("X14") = "30" Then
 
    Range("X13") = "45"
    
End If

   Range("X14") = "45" Then
    
   Range("W13") = Range("W14") + "1"
    Range("X13") = "0"
    
    Else
    
    Range("W13") = Range("W14")
    
End If


End If


  If Range("B13") = Range("B14") And Range("C13") = Range("C14") And Range("D13") = Range("D14") And Range("E13") = Range("E14") Then
   
    Rows(13).Delete
    
   End If
End Sub

Código: Selecionar todos

Sub callnovacelula()
Application.OnTime TimeValue("10:15:01"), "novacelula"
Application.OnTime TimeValue("10:30:01"), "novacelula"
Application.OnTime TimeValue("10:45:01"), "novacelula"
Application.OnTime TimeValue("11:00:01"), "novacelula"
End Sub

Código: Selecionar todos

Sub junto()

Call MaiorMenor
Call callzeramaxima
Call callrefatt
Call calltdjunto
Call callnovacelula
End Sub

[Jimmy]

Bom dia!!

Por favor, me mande novamente a refatt e a Tdjunto porque não vieram completas. Não sei se faltou apenas o END SUB ou se algo mais.

Não vou entrar no mérito do que faz cada rotina, porque está funcionando. Vou apenas tentar desenvolver a rotina periódica, para que ela acione as demais. Se o problema de travamento tiver origem em diversas rotinas executando periodicamente, e de forma crescente (mais de uma execução da mesma rotina), pode ser que esse gerenciamento único de execuções resolva.

Algumas perguntas:

Sub zeramaxima()
Inicia sempre as 10:00:00, ou pode ser que inicie em outro horário?
São sempre 4 execuções?
Os intervalos são sempre de 15 minutos?

Sub refatt()
Inicia sempre 1 MINUTO ANTES de cada execução da zeramaxima, independente do horário em que essa última iniciou?

Sub Tdjunto()
Inicia sempre 1 SEGUNDO ANTES de cada execução da zeramaxima, independente do horário em que essa última iniciou?

Sub novacelula()
Inicia sempre 1 SEGUNDO DEPOIS de cada execução da zeramaxima, independente do horário em que essa última iniciou?

Jimmy San Juan

[yanrichardd]

Bom dia!

"refatt" e "tdjunto" só faltaram o End Sub.

Sub zeramaxima()
Pode iniciar em outro horário, mas normalmente é executada as 10:00 depende da hora que eu acordo.

São sempre 4 execuções?
Sim
Os intervalos são sempre de 15 minutos?
Sim

Sub refatt()
Inicia sempre 1 MINUTO ANTES de cada execução da zeramaxima, independente do horário em que essa última iniciou?
Sim

Sub Tdjunto()
Inicia sempre 1 SEGUNDO ANTES de cada execução da zeramaxima, independente do horário em que essa última iniciou?
Sim

Sub novacelula()
Inicia sempre 1 SEGUNDO DEPOIS de cada execução da zeramaxima, independente do horário em que essa última iniciou?
Sim

[Jimmy]

Ok, vol alterar a macro.

Vou precisar de 2 células da planilha, e gostaria que você me dissesse quais poderiam ser, para que eu já use seus endereços na macro.

A primeira será para você informar a hora de início. Ai você aciona o processamento, começa a guardar o maior e menor valor, mas só realizará os demais procedimentos no horário estipulado nessa célula. Se você acordar mais tarde, altera ela de 10:00:00 para 11:30:00, por exemplo, e mesmo que sejam ainda 11:17:00 você já pode acionar a macro, que às 11:30:00 o apito é dado e o jogo começa.

A segunda é pra registrar, através de seu conteúdo, que há uma macro rodando. Isso evitará que sejam acionadas novamente, e tudo fique rodando em duplicata.

Se estiver bom dessa forma, me dê sinal verde.

Mais uma dúvida:
As macros Tdjunto e novacelula rodam sempre 1 SEGUNDO ANTES e 1 segundo após e cada execução da zeramaximo
Ex: 13:29:59, 13:30:00 e 13:30:01

Por acaso não ficaria melhor se rodassem as 3 macros às 13:30:00, porém primeiro a Tdjunto, depois a zeramaximo e por último a novacelula ?

Peço um favor: dá uma olhada nas mensagens anteriores, e se tiver alguma que de alguma forma te ajudou, e esqueceu de clicar na mãozinha (like), clica lá. Obrigado.

Jimmy San Juan

[yanrichardd]

Jimmy, pode deixar em branco as duas celulas que eu preencho depois, obrigado.

Pode ser também todas juntos nessa ordem que mandastes.
Obrigado!

[Jimmy]

Olá,

Alterei a macro, segue anexa, mas a planilha está sem dados.

Agora há apenas 6 macros, e não mais 10.

A macro INICIO, lê os parâmetros digitados, defini quando serão os 2 eventos
(EVENTO1:o que ocorre 1 minuto antes do horário de início / EVENTO2, que ocorre no horário de início, e após os períodos), e depois aciona a segunda macro, a PERIODICA.

A PERIODICA roda a cada 1 segundo, faz o que deve ser feito a cada segundo, e se auto-acionando.

Quando atinge o EVENTO1 ou EVENTO2, ela aciona a macro correspondente (“refatt” no EVENTO1, e “Tdjunto”, “zeramaxima” e “novacelula” no EVENTO2.). Após isso já ajusta o próximo evento (1 ou 2) para um PERÍODO mais tarde.

As outras 4 macros são as que você conhece: “refatt”, “Tdjunto”, “zeramaxima” e “novacelula”. Cada uma delas imprime a hora e o nome da macro na janela do Debug.print apenas para acompanhamento da execução, se necessário. As linhas DEBUG.PRINT... podem ser apagadas caso esse acompanhamento não seja preciso.

Se as macros “Tdjunto”, “zeramaxima” e “novacelula” rodam juntas, porque não juntar as 3 numa só macro?

Na macro “novacelula” há IFs de X14 comparando com 0, 15, 30 e 45. Como a execução agora pode iniciar em qualquer horário definido pelo operador, e como o intervalo entre leituras não precisa ser necessariamente 15 minutos (pode ser qualquer um), pode ser que seja necessário revisar esses IFs. Como não conheço a planilha, não posso sugerir nada.

Peço que teste exaustivamente. Vamos ver se com esse formato os travamentos deixam de acontecer.

Jimmy San Juan

[yanrichardd]

Obrigado Jimmy, irei testar e te dou o feeback!

[yanrichardd]

Jimmy, tudo certo. Só uma coisa, quando eu trabalho em outra planilha do excel ao mesmo tempo ele crasha... Como eu poderia resolver isso?

[Jimmy]

Tente fazer assim.

Abra o Excel e carregue a planilha de max e min;
Ponha pra rodar;
Dê um clique direito sobre o ícone do Excel na barra de tarefas. Aparece um menu, onde vai encontrar EXCEL 2016 ou EXCEL 2013, etc.
Segure a tecla ALT e clique no EXCEL 2013 (ou o que for)
O Windows vai perguntar se quer abrir o Excel em uma nova instância, ou seja, totalmente independente do primeiro EXCEL aberto;
Diga que sim;
Carregue nele a nova planilha e trabalhe.

Dê retorno do resultado.

Jimmy San Juan