Ir ao conteúdo

Macro p registra máxima e mínima


eletron1791

Posts recomendados

Postado

Pessoal, preciso de duas macros bem simples

Tenho A1 variando o tempo todo e preciso registrar em B1 a máxima e em C1 a mínima, ou seja, a máxima deve ficar congelada em B1, só variar se houver outra máxima em A1, o mesmo vale para a mínima.

Tenho A2 variando o tempo todo e preciso que quando o seu valor for igual a B2, ocorra um único BIP mas B2 fique em vermelho negrito direto, ou seja, mesmo que depois A2 seja diferente de B2. Já se A2 for igual a C2 ocorre também um único BIP mas C2 fica em azul negrito direto. A condição de ficar em negrito só se desfaz (reseta) se eu fechar o excel mesmo salvando. Quando eu re-abrir o arquivo aí B2 e C2 não mais estarão em negrito.

Se que pra vocês isso é moleza. Alguém pode ajudar ?...obrigado

Postado

Saudações!

O grande macete é o evento... Before Change... Conhece?

Basta incluir o código:


if range("A1").value > range("B1").value then
range("B1").value = range("A1").value
End if

if range("A1").value < range("C1").value then
range("C1").value = range("A1").value
End if

Espero que tenha ajudado. E até a próxima!

Postado

Boa Noite!

faça assim!

Abra a parte de VBA e coloque os seguintes codigos!

em ESTA_PASTA_DE_TRABALHO

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Sheets("Plan1").Range("B2:C2").Interior.Color = xlNone

End Sub

esta vai limpar as cores das celulas ao fechar!

Na parte da planilha, que imagino que seja a Plan1 (Plan1) coloque este

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Colunas As Range

Set Colunas = Range("A1")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

On Error Resume Next

'by Leno Mota

If Range("A1").Value > Range("B1").Value Or Range("B1").Value = "" Then

Range("B1").Value = Range("A1").Value

End If

If Range("A1").Value < Range("C1").Value Or Range("C1").Value = "" Then

Range("C1").Value = Range("A1").Value

End If

End If

Set Colunas = Range("A2")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

On Error Resume Next

If Range("A2").Value = Range("B2").Value Then

Call Tocar

Range("B2").Interior.Color = RGB(255, 0, 0)

End If

If Range("A2").Value = Range("C2").Value Then

Call Tocar

Range("C2").Interior.Color = RGB(0, 0, 255)

End If

End If

End Sub

Crie um MODULO e coloque este....

Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

'Aqui é pra emitir o som!

Sub Tocar()

'Onde 200 é a frequencia

'E 500 é o tempo em milisegundos

Beep 200, 500

End Sub

Espero ter ajudado!

OBS: o codigo do amigo Leno ja esta incluido neste que postei!

e coloquei um complemento nele para q qndos as celulas B1 e C1 estiverem vazias

eles pegarem o primeiro valor digitado em A1:rolleyes:

Um Abraço!:cool:

Postado

Obrigado Deejaywesley ficou perfeito e também Leno Mota.

Uma última pergunta, a minha condição número dois, que faz gerar o som e mudar as cores das células conforme valor da célula A2 na verdade eu precisaria monitorar não só a A2 mas de A2 até A20. Ou seja, acontecer a mesma coisa com as células contidas neste intervalo. Por exemplo, B2 e C2 geram som e variam cor conforme A2. B3 e C3 geram o mesmo som e variam cor conforme A3 e assim simultaneamente até a A20.

Assim mata a questão de vez.

Pode dar mais esta força ? obrigado

Postado

Boa Tarde!

Substitua esses dois codigo e veja se é o que quer!

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Sheets("Plan1").Range("B2:C20").Interior.Color = xlNone

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Colunas As Range

Set Colunas = Range("A1")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

On Error Resume Next

'by Leno Mota

If Range("A1").Value > Range("B1").Value Or Range("B1").Value = "" Then

Range("B1").Value = Range("A1").Value

End If

If Range("A1").Value < Range("C1").Value Or Range("C1").Value = "" Then

Range("C1").Value = Range("A1").Value

End If

End If

Set Colunas = Range("A2:A20")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

On Error Resume Next

If Range("A" & linha).Value = Range("B" & linha).Value Then

Call Tocar

Range("B" & linha).Interior.Color = RGB(255, 0, 0)

End If

If Range("A" & linha).Value = Range("C" & linha).Value Then

Call Tocar

Range("C" & linha).Interior.Color = RGB(0, 0, 255)

End If

End If

End Sub

:rolleyes::rolleyes::rolleyes:

Um Abraço!:cool:

Postado

Copiei e colei os códigos para uma planilha que já estava pronta e tomei o cuidado de trocar o nome de plan1 para o nome real da minha planilha (a que recebeu os códigos copiados). A sua parte do monitoramento mudando cores e gerando som funcionou perfeitamente. Mas aquela parte sugerida pelo nosso colega Leno Mota parou de funcionar. No caso eu fui obrigado a mudar as referentes pois as células eram outras, ficando assim: U25 é a célula que altera valor, X4 deve ser a célula que registra e mantém o valor mínimo variado em U25, e Y4 valor máximo registrado em U25.

Por que será que não quer funcionar ?

Postado

Bom Dia!

Olha! como você nao postou o codigo que você altero, eu nao posso te falar com certeza qual é o problema!

mas... pode ser porque você so alterou o codigo do amigo leno e nao o meu tbem....:muro:

logo acima do codigo do leno tem essa parte

Set Colunas = Range("A1")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

On Error Resume Next

onde A1 é a celula que fica sempre mudando os valores!:rolleyes:

se nao for isso, poste o codigo inteiro que você alterou!:cool:

Postado

Deejaywesley você tinha razão, eu não havia alterado ali em cima do código do Leno. Agora funcionou. Só que surgiu um problema. No seu código, aquele que monitora as células, varia cor e emite o som não está funcionando pois as células que eu estou monitorando vem de um link DDE. Até fiz o teste de digitá-las manualmente e aí dá certo. Mas se deixá-las (e tenho que deixar) recebendo dados do link DDE externo aí não ocorre os monitoramentos.

Por que será ?

E por fim: Tem jeito de eu ter a opção de quando ocorrer a condição do beep tocar ele travar e ficar tocando direto até que eu pressione a tecla X por exemplo.

Valeu

Deejaywesley você tinha razão, eu não havia alterado ali em cima do código do Leno. Agora funcionou.

PIOR é que agora percebi que também o código do Leno só funciona manualmente pois a minha célula que fica variando também vem do mesmo link DDE.

Postado

Bom Dia!

Poste um modelo de sua planilha em um site, e poste o link para download!

tenho que fazer uns testes!

quanto a sua duvida!

no codigo do Bip, nesta linha

Beep 200, 500

o 500 ali é o tempo que o Bip fica tocando, (tempo em milisegundos)

ai você coloca a duração que você quiser...:lol:

agora pra fazer ele para apertando o X...

eu no faço ideia de como fazer isso:seila::seila::seila::seila::seila:

mas fica tranquilo, se tiver como, os feras em VBA aqui altera o codigo pra você!:aplausos:

aguardando!:rolleyes:

Postado

Legal a ideia do tempo ali em milisegundos, eu tenho algum limite ali ? por exemplo poderia pôr para ficar durante horas bastando apenas converter ?

Sobre postar a minha planilha e até poderia mas não seria possível você utilizar o outro programa que gera os sinais via link DDE sendo assim acho que não ajudaria tanto. O que eu fiz foi copiar e colar abaixo o exemplo de como o linkDDE é, não sei se isso ajuda:

=SPIN|COTC!'BRKM5,LAST'

Este linkDDE está na minha célula C20, se eu apagar este link e simplesmente digitar um valor aí sim vejo as células G20 e H20 fazendo aquele monitoramento. É que eu tive que mudar sendo as células C variando e as G e H monitorando.

A mesma "interferência" do linkDDE está ocorrendo com o código do Leno. Ou seja, só funciona se digitar no teclado. Por que será ?

Legal a ideia do tempo ali em milisegundos,

VEJA SÓ, eu havia me enganado quando eu disse que havia linkDDE atrapalhando o monitoramento do código do Leno. Ali a célula que está sendo monitorada não tem linkDDE mas tem uma soma. Ou seja, ela resulta de uma soma de outras células e nem assim funciona. Só funciona "na mão", só funciona quando eu digito o valor. Tirei até umas duas formatações condicionais, tipo deixá-la vermelho se valor negativo, mas nem assim. Só funciona se eu digitar os dados.

Por que será ? (já as demais estas sim está correto ao afirmar que possuem linkDDE)

O que significa uma mensagem ser editada pelo moderador ?

  • Membro VIP
Postado

Boa tarde Sérgio

Se você ler abaixo na tua primeira mensagem verá o motivo porque ela foi editada.

Nos fóruns não são aceitos mensagens com títulos como: Ajuda, Help, etc...

Postado
Boa tarde Sérgio

Se você ler abaixo na tua primeira mensagem verá o motivo porque ela foi editada.

Nos fóruns não são aceitos mensagens com títulos como: Ajuda, Help, etc...

Perdoe-me colega, eu não tenho os macetes destes fóruns, mas o que acontece com uma mensagem editada ? editar significa alterar, modificar, etc. O que ocorre com uma mensagem editada ? E o título da mensagem inicial não foi "macro que registra máxima e mínima" que mal tem neste título ?

Postado

Bom Dia!

Estou tentando achar uma solução para o problema!

e tive uma ideia, mas me diga uma coisa sobre sua planilha,,,

de quanto em quanto tempo os dados das celulas sao atualizados?

:rolleyes:

Ah! quanto a parte de topico editado pelo moderador, nao é nada pra se preocupar nao!

como o Amigo Patropi disse!

é alguma coisa que nao esta de acordo com o forum.

qndoé editado, o topico nao trava nao rsrssr demorei a responder

porque ontem era terça, e as terças eu trabalho no som de um leilão, e nao tenho net lá kkkkkkkkk

aguardando:rolleyes:

Postado

Caro Deejaywesley, veja, coloquei aquele seu código que inclui o do Leno numa nova planilha (do zero). Fiz uma soma em E1+E2 e coloquei A1 para mostrar o resultado desta soma. E realmente notei que sendo assim a macro não funciona, ou seja, desta forma B1 e C1 ignoram valores máximos e mínimos. Só funciona se eu digitar em A1.

O mesmo vale para aquela segunda macro que monitora A2 a A20. Coloquei em A1 um linkDDE externo e a macro não mais fez o monitoramento.

Não dá pra saber de quanto em quanto tempo ocorre a atualização do link DDE. Mas você pode fazer o teste que eu diz, abrir uma planilha em branco e fazer da célula A1 uma soma de duas outras células qualquer. E de repente pode também simular um linkDDE externo vindo talvez de alguma outra planilha para A2 e aí verá que as macros não funcionam.

Postado

Nao Parceiro!

nao quero saber o tempo ceto de uma atualizaçaõ!

quero saber + ou - o intervalo, se é a cada 20 seg..... 2 minut..... 1hoea e meia....

porque minha ideia, é a segunite, o codigo q te mandei, ele nao ta funcionado porque

ele reconhece as alteraçoes que você faz.... nao a de formulas...

ai eu pensei em colocar os codigo rodando direto por tempo...

por ex a cada 10 segundos ele roda os codigos e verifia as celulas...

ainda nao tentei fazer assim pra ver se vai funcionar, ainda vou fazer os testes!

Postado

Eu sei que mais fácil seria postar a minha planilha mas eu teria que me cadastrar nestes sites e todo aquele blá-blá-blá. As atualizações são rápidas, tipo 1 segundo, até porque monitoro 20 linhas e cada uma altera em momentos diferentes. Realmente não dá para saber.

Mas faça aquele teste por favor, abra uma em branco, é bem rápido, de cara vai perceber que em A1 não acontece aquele monitoramento de máximo e mínimo caso A1 seja o resultado de uma soma por exemplo.

Tô acompanhando, obrigado

  • Membro VIP
Postado

No site:

www.sendspace.com

não precisa se cadastrar.

As pessoas ficam com preguiça de montar um modelo para facilitar, mas nós que somos voluntários temos que montar o modelo para conseguirmos resolver...

Você acha isso justo????

Att

Postado
No site:

Att

Pode até ser mas com relação ao mim você está enganado, não saco muito destas novas tecnologias, e para ser sincero de nada vai adiantar eu enviar a minha planilha pois não será possível enviar o programa ao qual ela está vinculada, sendo assim dá no mesmo montar uma planilha nova, eu que sei pouco (tô aprendendo) gastei 3 minutos para copiar e colar as macros e ver a nova planilha funcionar.

Confia em mim Patrulheiro

Postado

Boa Tarde!

faça o teste ai...

em ESTA PASTA DE TRABALHO coloque esta

Private Sub Workbook_Open()

Set Arquivo = ActiveWorkbook

Application.OnTime Now + TimeValue("00:00:20"), "salvar"

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Sheets("Plan1").Range("B2:C2").Interior.Color = xlNone

End Sub

aqui 00:00:20 é pra atualizar a cada 20 segundos faça os testes e

mude conforme ficar melhor na sua planilha

em PLAN1 (PLAN1) coloque esta

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Colunas As Range

Set Colunas = Range("A1")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

On Error Resume Next

'by Leno Mota

If Range("A1").Value > Range("B1").Value Or Range("B1").Value = "" Then

Range("B1").Value = Range("A1").Value

End If

If Range("A1").Value < Range("C1").Value Or Range("C1").Value = "" Then

Range("C1").Value = Range("A1").Value

End If

End If

Set Colunas = Range("A2:A20")

If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then

linha = Target.Row

On Error Resume Next

If Range("A" & linha).Value = Range("B" & linha).Value Then

Call Tocar

Range("B" & linha).Interior.Color = RGB(255, 0, 0)

End If

If Range("A" & linha).Value = Range("C" & linha).Value Then

Call Tocar

Range("C" & linha).Interior.Color = RGB(0, 0, 255)

End If

End If

End Sub

é a mesma, so faça as alteraçoes para as celulas da sua...

no modulo crie aquele do Bip

e crie outro e coloque este

Option Explicit

Global Arquivo As Workbook

Function salvar()

Sheets("Plan1").Range("A1").Value = "=D1+E1"

Sheets("Plan1").Range("A2").Value = "=SPIN|COTC!'BRKM5,LAST'"

Sheets("Plan1").Range("A3").Value = "=SPIN|COTC!'BRKM5,LAST'"

Sheets("Plan1").Range("A4").Value = "=SPIN|COTC!'BRKM5,LAST'"

Sheets("Plan1").Range("A5").Value = "=SPIN|COTC!'BRKM5,LAST'"

Sheets("Plan1").Range("A6").Value = "=SPIN|COTC!'BRKM5,LAST'"

Sheets("Plan1").Range("A7").Value = "=SPIN|COTC!'BRKM5,LAST'"

'coloque ate a linha 20

Application.OnTime Now + TimeValue("00:00:20"), "salvar"

End Function

esse ai coloca a cada 20 segundos as formulas nas celulas, dando assim o range

que precisa para rodar as outras macros...

aguardando!:rolleyes:

Postado

Caro Deejay,

Vi aqui que não podería ser monitoramento de tempos em tempos mas sim no exato instante em que o valor na célula a ser monitorada variar para mais ou para menos. Mas variar sozinha, sem ser digitando pelo teclado.

Estou colhendo dados de um programa específico que altera as células de acordo com a cotação de um determinado ativo, mas é impossível dizer que o valor será alterado em X segundos, mas quando ele for alterado tem que instantaneamente gerar as condições previstas nas macros.

Acompanhando...

Postado

Não amigo!

mas é impossível dizer que o valor será alterado em X segundos,

você nao precisa saber a que momento vai aver atualizaçao...

o codigo que te passei, a cada 20 segundos ele vai comparar as celulas,

pra ver se as as primeiras sao maiores ou menores...

e se alguma das outras sao iguais...

os 20 segundos você pode mudar colocar 5 por ex....

obs: os segundos devem ser alterados nos dois codigos....

ai tendo alteraçao ou nao tendo, ele vai comparar, ou seja sua planilha vai estar atualiza

sempre o dia todo....

entendeu a minha ideia agora....

Postado

Foi isso que eu entendi.

Mas veja, monitoro 20 valores, pode ser que quatro deles alterem valor a cada 0,3 segundos, se eu baixar aquele valor da sua macro para 0,5 segundos, ainda assim não estará ocorrendo em real-time. Mas vou tentar aqui e te falo.

Postado

Application.OnTime Now + TimeValue("00:00:00:50"), "salvar"

Mudei no módulo e naquela primeira pasta tentando deixar com 0,5 segundos mas deu erro de depuração mostrando a linha acima em amarelo. Vou deixar com 00:00:01 pra ver

De repente mostrou: Erro em tempo de execução "9"

Subscrito fora do intervalo D1+E1

Acho que estava indo bem com 1 segundo, preciso fazer mais testes.

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!