Excel Excel copia e guarda "X" valores entregues pelo RTD (Real Time Data)

[Alexandre José Costa]

Boa tarde a todos. 

Tenho um "quebra cuca" dos bons aqui e venho pedir a ajuda dos programadores.

A planilha recebe dados em tempo real da Bolsa de Valores via RTD (Real Time Data).
Portanto, só vemos o dado/valor atual na tela até que ele seja atualizado novamente.

São vários indicadores e em alguns deles eu preciso do valor atual na coluna D (que

já tenho, pois é dado pelo RTD) e dos últimos cinco (5) valores que já se passaram.

Os últimos cinco serão colocados na mesma linha, nas colunas seguintes: E, F, G, H e I.

Basicamente, o VBA tem que copiar o valor atual dado pelo RTD e quando o valor 

atual mudar, teremos o valor atual e a cópia do anterior. Assim:

- Quando o valor atual mudar, nós teremos o valor atual e a cópia do anterior;

- Quando o valor atual mudar, nós teremos o valor atual e as duas cópias anteriores;

- Quando o valor atual mudar, nós teremos o valor atual e as três cópias anteriores;

- Quando o valor atual mudar, nós teremos o valor atual e as quatro cópias anteriores;

- Quando o valor atual mudar, nós teremos o valor atual e as cinco cópias anteriores.

 

É desta forma que eu quero que a planilha organize estas informações.

 

A planilha segue anexa com um exemplo. Nela eu uso o exemplo de um indicador de

topos e fundos. O indicador Topo/Fundo traz dois valores, o último topo e o último fundo.

 

Estes dois valores vão sendo atualizados conforme o mercado vai subindo ou caindo, formando um zigzag de topos e fundos, para cima ou para baixo, durante o movimento do preço. 

 

Na planilha anexa eu coloquei duas abas: 

 

1) Aba TABELA: onde está a tabela nas primeiras sete linhas, objeto de nossa programação;

2) Aba ESQUEMA: está um esquema para facilitar o entendimento;
 

Desde já agradeço a ajuda. 

 

Exemplo_Excel guardar os últimos valores entregues pelo RTD .xlsx

[Midori]

@Alexandre José Costa Para guardar os dados na sequencia, a atualização pode ser no evento calculate já que a planilha tem um link em tempo real. Faça um teste, no código considerei o range D43 como o valor atual V-0.

 

Private Sub Worksheet_Calculate()
    Call Atualiza(Me.[D43], 5)
End Sub

Sub Atualiza(Atual As Range, Colunas As Integer)
    Dim Sequencia   As Range
    Dim Conta       As Integer
    
    Set Sequencia = Atual.Offset(0, 1).Resize(1, Colunas)    
    Conta = WorksheetFunction.CountA(Sequencia)
    
    If Conta <> 0 Then
        Set Sequencia = Atual.Offset(0, 1).Resize(1, Conta)
        If Conta = Colunas Then
            Sequencia.Resize(1, Conta - 1).Copy
        Else
            Sequencia.Copy
        End If        
        Call Sequencia.Offset(0, 1).PasteSpecial(xlPasteValues)
        Application.CutCopyMode = False
    End If    
    Atual.Offset(0, 1).Value = Atual.Value
End Sub

 

[Alexandre José Costa]

Midori, 

Boa noite. 
Antes de qualquer comentário eu quero agradecê-la pelo código e seu retorno.

Ao colocar o código na planilha real, eu percebi algumas coisas:

1. O código preenche os espaços reservados para armazenar as últimas 5 informações. Perfeito;
    
2. Se tento navegar na aba onde o código foi inserido, ele não permite. Qualquer cél que eu clique, o comando não é atendido, o VBA deixa as últimas 4 céls ativas (V-2, V-3, V-4, V-5), forçando a navegação apenas dentro destas 4 céls, e mesmo assim, com dificuldade;
    
3. Na planilha real onde este código será usado, tem mais abas do que a plan que montei de exemplo aqui para o fórum e a toda a planilha (real) fica piscando, em qualquer aba;
   
   OBS: a saber, eu coloquei o código na aba Variáveis da planilha real e não dentro de um módulo. Não sei qual é a forma correta. Abaixo deixo um anexo para que veja.
    
4. Quando ligo o RTD, o código preenche todas as 5 céls reservadas para receber as infos, mas apenas com a última informação, ele não mantém o registro das últimas 5 informações entregues pelo RTD;
    

Se eu estiver fazendo algo errado, por favor, peço gentilmente que me oriente, ok?

 

[Midori]

@Alexandre José Costa Para resolver as questões 2 e 3 substitui o método Copy/PasteSpecial por um Loop que atribui os valores na coluna, assim a macro não fica selecionando a célula como antes, veja se resolve.

 

Sobre a questão 4. A macro vai atualizando a sequencia a medida que o valor é atualizado. E como no seu exemplo mantém os 5 últimos. Pode mostrar como está de como gostaria que ficasse?

 

Sub Atualiza(Atual As Range, Colunas As Integer)
    Dim Conta As Integer
    
    Conta = WorksheetFunction.CountA( _
        Atual.Offset(0, 1).Resize(1, Colunas))
    
    If Conta <> Colunas Then
        Conta = Conta + 1
    End If
    
    While Conta > 0
        Atual.Offset(0, Conta).Value = _
            Atual.Offset(0, Conta - 1).Value
        Conta = Conta - 1
    Wend
End Sub

 

 

[Alexandre José Costa]

2 horas atrás, Midori disse:

Para resolver as questões 2 e 3 substitui o método Copy/PasteSpecial por um Loop que atribui os valores na coluna, assim a macro não fica selecionando a célula como antes, veja se resolve.

Midori, bom dia. 

Eu não sei fazer isso, infelizmente. Eu tentei, mas não sei o que estou fazendo. 
Poderia fazer a substituição?

2 horas atrás, Midori disse:

Sobre a questão 4. A macro vai atualizando a sequencia a medida que o valor é atualizado. E como no seu exemplo mantém os 5 últimos. Pode mostrar como está de como gostaria que ficasse?

Claro. Veja se é isso que quer saber. Abaixo deixo um print de parte da plan (real) para você ver quais registros o VBA está deixando nas 5 colunas e como deveria ser:

[Midori]

@Alexandre José Costa Na janela do editor de macro do print que você postou tem que ficar só com este código,

 

Private Sub Worksheet_Calculate()
    Call Atualiza(Me.[D43], 5)
End Sub

Sub Atualiza(Atual As Range, Colunas As Integer)
    Dim Conta As Integer
    
    Conta = WorksheetFunction.CountA( _
        Atual.Offset(0, 1).Resize(1, Colunas))
    
    If Conta <> Colunas Then
        Conta = Conta + 1
    End If
    
    While Conta > 0
        Atual.Offset(0, Conta).Value = _
            Atual.Offset(0, Conta - 1).Value
        Conta = Conta - 1
    Wend
End Sub

 

[Alexandre José Costa]

Certo. Vou fazer a alteração e já lhe falo. 

[OreiaG]

Segue uma alternativa. Veja se pode lhe ajudar.

Cole o código abaixo no módulo da planilha de interesse >> clique com o direito na guia da planilha >> Exibir Código.

Private Sub Worksheet_Calculate()
 Application.ScreenUpdating = False
 [I4:I5] = "": [D4:D5].Copy: [E4].Insert shift:=xlToRight
End Sub

 

[Alexandre José Costa]

20 minutos atrás, Midori disse:

@Alexandre José Costa Na janela do editor de macro do print que você postou tem que ficar só com este código,

 

Private Sub Worksheet_Calculate()
    Call Atualiza(Me.[D43], 5)
End Sub

Sub Atualiza(Atual As Range, Colunas As Integer)
    Dim Conta As Integer
    
    Conta = WorksheetFunction.CountA( _
        Atual.Offset(0, 1).Resize(1, Colunas))
    
    If Conta <> Colunas Then
        Conta = Conta + 1
    End If
    
    While Conta > 0
        Atual.Offset(0, Conta).Value = _
            Atual.Offset(0, Conta - 1).Value
        Conta = Conta - 1
    Wend
End Sub

 

Midori, 

Eu fiz a alteração. A macro roda.
A questão do pisca-pisca não existe mais.

Sobre os últimos 5 registros, estes não estão sendo armazenados nas colunas. Se a cél D43 é alterada, todas as outras 5 cols repetem o valor da D43. Mudei o valor manualmente dentro da plan real. Coloco 1, tudo vira 1. Coloco 2, tudo vira 2, e assim por diante. 

Uma pergunta: a plan real é .xls. Devo salvá-la como .xlsm?

4 minutos atrás, OreiaG disse:

Segue uma alternativa. Veja se pode lhe ajudar.

Cole o código abaixo no módulo da planilha de interesse >> clique com o direito na guia da planilha >> Exibir Código.

Private Sub Worksheet_Calculate()
 Application.ScreenUpdating = False
 [I4:I5] = "": [D4:D5].Copy: [E4].Insert shift:=xlToRight
End Sub

 

Vou fazer aplicar esta alternativa. Um minuto e já retorno.

22 minutos atrás, OreiaG disse:

Segue uma alternativa. Veja se pode lhe ajudar.

Agora que vi que o post foi da OreiaG. Obrigado.
Este código é para manter o registro dos 5 valores, correto?
Estou testando juntamente com o VBA da @Midori.

47 minutos atrás, Midori disse:

Na janela do editor de macro do print que você postou tem que ficar só com este código,

Midori, 

Fiz a alteração. O código ainda não armazena as últimas 5 informações, ele preenche todas as cols, com o último valor da D43.

[Midori]

1 hora atrás, Alexandre José Costa disse:

Claro. Veja se é isso que quer saber. Abaixo deixo um print de parte da plan (real) para você ver quais registros o VBA está deixando nas 5 colunas e como deveria ser:

A macro escreve na planilha na mesma taxa de atualização do link RTD. Se a atualização p.ex for a cada segundo ou menos, independente do valor atual, a macro será executada. Se esse for o caso a macro pode ter uma condição para não escrever caso o valor atual seja igual ao último da sequencia. Ou pode ter um cronometro para escrever a cada intervalo determinado de tempo.

[Alexandre José Costa]

55 minutos atrás, Midori disse:

a macro pode ter uma condição para não escrever caso o valor atual seja igual ao último da sequencia

Midori, 

Acho que você matou a charada. Deve resolver com isso. Realmente faz sentido porque quando o valor da D43 é alterado, as colunas vão pegando o valor da D43 uma a uma, sequencialmente até que todas fiquem iguais, não muda de uma vez só. De fato, deveria alterar a col V-1 apenas e os outros valores (mais antigos) seriam "empurrados" para frente, para as cols da direita. Dizer "empurrados para a direita" é só uma maneira diferente de dizer o que já descrevi na planilha de exemplo.

Poderia, por favor, colocar esta condição, por alteração de valor e não por tempo?

[Edson Luiz Branco]

Boa tarde colegas!

Não cheguei a analisar os códigos e toda a problemática, mas a respeito dessa última situação, uma possibilidade que também poderia interferir é que, apesar de a cópia/colagem de valores puros não dispararem o evento Calculate nas células destino, se existirem células que dependam direta ou indiretamente delas (ou seja, se estiverem no caminho ou árvore de dependência)  então o recálculo ocorrerá e o processo ficará em loop momentâneo, possibilitando que os valores fiquem indesejavelmente repetidos.

Talvez fazer então um teste desligando a armadilha de eventos imediatamente antes de colar os valores (com Application.EnableEvents = False) e religando em seguida (Application.EnableEvents = True)...

[Alexandre José Costa]

21 minutos atrás, Edson Luiz Branco disse:

se existirem células que dependam direta ou indiretamente delas (ou seja, se estiverem no caminho ou árvore de dependência)  então o recálculo ocorrerá

@Edson Luiz Branco, obrigado pela colaboração. 
As céls que armazenam as infos (V-1 até V-5) bem como a cél que mantém o valor atual entregue pelo RTD (V-0) serão usadas como referências em fórmulas. Você acha que neste caso recai sobre a citação que você fez acima?

[Midori]

@Alexandre José Costa A macro editada com o a dica do @Edson Luiz Branco ficou assim. Veja se resolve ou podemos tentar colocar a condição do valor que comentei,

 

Private Sub Worksheet_Calculate()
    Application.EnableEvents = False
    Call Atualiza(Me.[D43], 5)
    Application.EnableEvents = True
End Sub

Sub Atualiza(Atual As Range, Colunas As Integer)
    Dim Conta As Integer
    
    Conta = WorksheetFunction.CountA( _
        Atual.Offset(0, 1).Resize(1, Colunas))
    
    If Conta <> Colunas Then
        Conta = Conta + 1
    End If
    While Conta > 0
        Atual.Offset(0, Conta).Value = _
            Atual.Offset(0, Conta - 1).Value
        Conta = Conta - 1
    Wend
End Sub

 

[Alexandre José Costa]

Midori, vou aplicar macro editada agora mesmo.
Já volto para lhe dizer como ficou. 

 

45 minutos atrás, Midori disse:

@Alexandre José Costa A macro editada com o a dica do @Edson Luiz Branco ficou assim. Veja se resolve ou podemos tentar colocar a condição do valor que comentei,

Midori,

Retornando, a alteração com a sugestão do @Edison Luiz Branco, infelizmente, não surtiu efeito. As cols ficam com o mesmo valor da D43.

[Midori]

@Alexandre José Costa A macro com a condição para atualizar a sequencia apenas se o valor atual for diferente do último, veja se resolve,

Private Sub Worksheet_Calculate()
    Call Atualiza(Me.[D43], 5)
End Sub

Sub Atualiza(Atual As Range, Colunas As Integer)
    Dim Conta As Integer
    
    Conta = WorksheetFunction.CountA( _
        Atual.Offset(0, 1).Resize(1, Colunas))
    
    If Conta <> Colunas Then
        Conta = Conta + 1
    End If
    
    If Atual.Value <> Atual.Offset(0, 1).Value Then
        While Conta > 0
            Atual.Offset(0, Conta).Value = _
                Atual.Offset(0, Conta - 1).Value
            Conta = Conta - 1
        Wend
    End If
End Sub

 

[Alexandre José Costa]

55 minutos atrás, Midori disse:

A macro com a condição para atualizar a sequencia apenas se o valor atual for diferente do último, veja se resolve,

Midori, 

Agora funcionou perfeitamente!
Os valores passados vão sendo armazenados em seus devidos lugares, nas colunas à frente. Tudo ao seu tempo, conforme D43 vai mudando. Lindo de ver. :-)

Pergunta: como eu comentei anteriormente, a coluna D na plan real tem muitos indicadores e em vários deles eu preciso armazenar os últimos valores como fizemos até aqui na cél D43. Ou seja, todos os indicadores na posição V-0 estão na coluna D.

Se eu quiser usar o vba nos outros indicadores, para toda a col D, basta eu alterar a parte do código como mostro abaixo? Se eu estiver falando bobagem, por favor, me corrija.

DE:      Call Atualiza(Me.[D43], 5)
PARA: Call Atualiza(Me.[D:D], 5)

 

[Midori]

@Alexandre José Costa Para pegar mais células o procedimento Calculate pode ter um loop no range dos valores, p.ex,

 

Aí considerei o range D1:D10, se for outro é só alterar. Dependendo do tamanho do range e da quantidade de atualizações pode haver alguma lentidão.

 

Private Sub Worksheet_Calculate()
    Dim Valor As Range
    
    For Each Valor In [D1:D10]
        If Valor.Value <> "" Then
            Call Atualiza(Valor, 5)
        End If
    Next Valor
End Sub

Sub Atualiza(Atual As Range, Colunas As Integer)
    Dim Conta As Integer
    
    Conta = WorksheetFunction.CountA( _
        Atual.Offset(0, 1).Resize(1, Colunas))
    
    If Conta <> Colunas Then
        Conta = Conta + 1
    End If
    
    If Atual.Value <> Atual.Offset(0, 1).Value Then
        While Conta > 0
            Atual.Offset(0, Conta).Value = _
                Atual.Offset(0, Conta - 1).Value
            Conta = Conta - 1
        Wend
    End If
End Sub

 

[Alexandre José Costa]

Bacana. Vou alterar aqui e ver como se comporta. Logo volto para lhe dar um retorno.

 

52 minutos atrás, Midori disse:

Para pegar mais células o procedimento Calculate pode ter um loop no range dos valores, p.ex,

Midori,

Adaptei o código como você me orientou e está funcionando lindamente. 
Olha, eu estou em êxtase aqui com o que você fez. Que trabalho magnífico. 

Não me  refiro apenas ao dev do código, sabe? Me refiro também a sua atuação aqui o Clube do Hardware, assim como de outros colegas que se propuseram a ajudar . É de cair o queixo.

@Midori 
@OreiaG
@Edson Luiz Branco

Espero que possamos nos encontrar novamente por aqui em novas oportunidades. 
Muito obrigado! :-)

[OreiaG]

4 horas atrás, Alexandre José Costa disse:

Dizer "empurrados para a direita" é só uma maneira diferente de dizer o que já descrevi na planilha de exemplo.

 

É exatamente isso que o código que eu sugeri faz.

Considerei que o RTD insere sempre os valores em D4:D5 da planilha Tabela do arquivo exemplo do seu primeiro post.

[Alexandre José Costa]

Olá @Midori

 

Boa tarde. 
Tudo bem com você? Espero que sim. 

Estou de volta para tentar solucionar um problema que está ocorrendo com a planilha.

O código continua o mesmo que você fez e estava tudo funcionando bem até que após um fechamento repentino do Excel, pareceu-me que o VBA passou a restringir os comandos que usualmente fazemos na planilha.
 

Coisas simples como navegar por entre as céls usando as setas e navegação pelo mouse deixaram de funcionar. Quando tento clicar no "X" para fechar o Excel, ele não obedece o comando.

Eu digo que pode ser o VBA porque quando tiro o código VBA da aba Variáveis, a planilha volta a funcionar normalmente.

Por favor, você vê alguma sugestão para solucionar o problema? Pensei que, talvez, algum comando via VBA pudesse contornar este controle indesejado sobre o Excel.

Desde já agradeço.

 

[Midori]

@Alexandre José Costa Sem o arquivo fica difícil sugerir algo. A planilha tem muitas fórmulas e leva tempo para calcular? O link RTD com a planilha está ok? Pode ser questão de processamento. Tente criar outro arquivo do zero com a macro só para ver se acontece o mesmo.

[Alexandre José Costa]

Oi  Midori, 

Obrigado pelo retorno.
Pensei em anexar a planilha aqui , mas como o problema é na planilha real (de produção), não posso colocá-la aqui, publicamente.

Vou fazer o que você falou e logo retorno. 

[Midori]

@Alexandre José Costa Como alternativa você pode testar esta Sub que modifiquei para usar Copy/Paste no lugar do Loop. Assim fica mais rápido,

 

Sub Atualiza(Atual As Range, Colunas As Integer)
    Dim Sequencia   As Range
    Dim Conta       As Integer
    
    Set Sequencia = Atual.Offset(0, 1).Resize(1, Colunas)
    Conta = WorksheetFunction.CountA(Sequencia)
    
    If Atual.Value <> Atual.Offset(0, 1).Value Then
        Set Sequencia = Atual.Offset(0, 1).Resize(1, IIf(Conta = 0, 1, Conta))
        If Conta = Colunas Then
            Call Sequencia.Resize(1, Conta - 1).Copy(Sequencia.Offset(0, 1))
        Else
            Call Sequencia.Copy(Sequencia.Offset(0, 1))
        End If
        Atual.Offset(0, 1).Value = Atual.Value
    End If
End Sub

 

[Alexandre José Costa]

@Midori 

 

Substitui o código anterior (loop) pelo código que você acabou de fazer (copy/paste). A planilha voltou a funcionar, mas com ressalvas. 

O RTD voltou a atualizar, o que não fazia antes, mas funciona apenas no V-0, onde coloco o link RTD. No entanto, ela deixou de armazenar os últimos 5 valores (V-1, V-2, V-3, V-4 e V-5).