Este fórum está sendo desativado

[saintannna]

Olá a todos.

É possível usar um código VBA para fazer que, a cada minuto, o valor de uma célula seja alterado?

Ex: A célula começa em 1. Um minuto depois a macro mudaria o número da célula para 2. Um minuto depois para 3 e por fim, depois de mais um minuto mudaria para 1. Depois que o número 4 estivesse na célula por 1 minuto o valor voltaria para 1. É possível?

[laennder]

Tente essa macro, alterando as referências

Código: Selecionar todos

Option Explicit

Sub auto_open() : TicTac: End Sub

Sub TicTac()
    Dim rngCelula As Range
    Set rngCelula = Worksheets("Plan1").Range("A1")
    If rngCelula = 3 Then rngCelula = 1 Else rngCelula = rngCelula + 1
    Application.OnTime Now + TimeValue("00:01:00"), "TicTac"
End Sub

[daniexcel]

tinha feito diferente

Código: Selecionar todos

Public altern As Date, i As Long

Sub IncrTempo()

    Range("a2").Select
    
    If Second(altern) > 3 Then
       ActiveCell.FormulaR1C1 = (Minute(altern) - Minute(altern) + i)
    Else
    ActiveCell.FormulaR1C1 = Minute(altern)
    End If
    

If i = 0 Then
i = 1
End If
altern = Now + TimeValue("00:01:00")
Application.OnTime altern, "IncrTempo"

If i < 4 Then
i = i + 1
Else: i = 1
End If
End Sub

Sub Desligar_IncrTempo()
On Error Resume Next
Application.OnTime earliesttime:=altern, procedure:="IncrTempo", schedule:=False
MsgBox "Timer desligado", vbInformation, "Status"
End Sub

mas achei o codigo de cima bem mais util...
valeu. vou utilizar o codigo tambem

unica coisa, que o que postei tem botao de desligar
mas voce pode utilizar no seu codigo tb

[saintannna]

Laennder e daniexcel, obrigado por responderem.

Depois de algum tempo tentando entender o porque não estava dando certo, finalmente consegui resolver o problema. Eu usei a solução que o Laennder escreveu, só que criei um módulo onde coloquei a rotina subTicTac() e em "EstaPasta_de_trabalho" eu coloquei um comando para selecionar a planilha que precisava que rodasse a rotina e um segundo comando para executar a rotina.

Resumindo:

EstaPasta_de_Trabalho

Option Explicit
Private Sub Workbook_Open()
Sheets("PLan1").Select
Run "TicTac"

Módulo 1
Sub TicTac()
Dim rngCelula As Range
Set rngCelula = Worksheets("Plan2").Range("P11")
If rngCelula = 4 Then rngCelula = 1 Else rngCelula = rngCelula + 1
Application.OnTime Now + TimeValue("00:00:10"), "TicTac"
End Sub

Obs: Foram feitas alterações para que resultado fosse como eu gostaria.

Obrigado novamente.