Página 1 de 1

Modificar o horário de células em uma seleção via VBA

Enviado: 05 Jan 2016 às 22:06
por joaohenriquemc
Boa noite, tenho um relatorio no excel e tenho que alterar horários contínuos nela, alterando minuto e segundo, e estou criando funções no excel para fazê-lo por mim, tenho um form com 10 TextBox, o usuário irá selecionar 8 células e o form irá dividir um minuto em 8 partes desiguais e somá-los a cada célula da seleção, fazendo parecer que alguem registrou aquela ação de forma real em um tempo não cronometrado porem no limite de 8 marcações por minuto, a parte que tenho dificuldade é de individualizar as células da seleção para que a macro possa somar a cada celula seu valor definitivo. e em seguida exibir esse valor nas textbox para dados de estatistica (não inportante por enquanto), o usuário ira selecionar de 8 em 8, compondo um minuto, entao o primeiro da seleção será a primeira celula correspondente a aquele minuto (com um valor mais baixo de segundos) e o ultimo da seleção sera com valor maior, finalizando o minuto) Ex:

06:02:17
06:02:21
06:02:53
06:03:28
06:03:31
06:03:32
06:03:40
06:03:49
06:04:09
06:04:22
06:04:44
06:04:46
06:04:49
06:04:50
06:04:52
06:04:57
06:07:00
06:07:08
o usuario ira selecionar 8 a 10 celulas, sendo assim nesses horarios acima iniciaria com 06:02:17 e na ultima celula da seleção seria por exemplo 06:12:56, uso excel 2003, e to quebrando a cabeça com isso, qualquer ajuda é bem vinda, obrigado!

Re: Modificar o horário de células em uma seleção via VBA

Enviado: 06 Jan 2016 às 10:24
por daniexcel
e se voce usar a fórmula abaixo?
Código: Selecionar todos
=TEMPO(HORA(AGORA());MINUTO(AGORA());ALEATÓRIOENTRE(0;59))
onde AGORA() pode ser substituído pelo horario da primeira célula... deste modo, você teria hora e minuto iguais aos da primeira celula e os segundos seriam distribuídos aleatoriamente

Modificar o horário de células em uma seleção via VBA

Enviado: 06 Jan 2016 às 15:00
por joaohenriquemc
Olá daniexcel, com essa fórmula cada celula teria um segundo aleatorio, asim a primeira celula poderia ter o segundo 13, a segunda 02 e a terceira 56 por exemplo, para calcular os valores aleatorios irei fazer assim, vai dividir um minuto em 8 partes iguais e a cada parte sera somado entre 2 a 5 segundos, e o código vai somando cada segundo desse que vai sendo somada a cada parte, e no final a soma desses segundos (2 a 5 segundos) será subtraído da ultima parte, assim sempre terei 59 segundos em 8 partes desiguais, mas minha dificuldade mesmo é como fazer o código atribuir cada célula a uma textbox já que as células nunca serão as mesmas, e só podem ser as células que estao selecionadas.

Re: Modificar o horário de células em uma seleção via VBA

Enviado: 06 Jan 2016 às 17:51
por daniexcel
Tente adequar sua necessidade à macro abaixo:
Código: Selecionar todos
Sub SegundosAleatorios()


    ActiveCell.FormulaR1C1 = "=IF(SECOND(NOW())>51,51,SECOND(NOW()))"
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(R[-1]C+1,53)"
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(R[-1]C+1,54)"
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(R[-1]C+1,55)"
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(R[-1]C+1,56)"
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(R[-1]C+1,57)"
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(R[-1]C+1,58)"
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(R[-1]C+1,59)"
ActiveCell.Offset(1, 0).Select

End Sub
Deste modo, toda vez que houver um segundo maior que 51, ele deixa o valor fixo e vai incrementando para as linhas seguintes entre o valor da célula anterior e 59-1 (da ultima celula para a primeira).
Sendo assim, voce nunca terá um horario repetido e o horario debaixo sempre será maior que o da linha acima e menor que o da linha abaixo, garantindo a sua validade cronologica.
Para fixar, é só usar incremento das celulas preenchidas e fixar com

Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Espero ter ajudado

Modificar o horário de células em uma seleção via VBA

Enviado: 06 Jan 2016 às 20:34
por joaohenriquemc
olá,daniexcel, obrigado pelo código, porém preciso usar o excel 2003 onde não tenho a funçã aleatorio entre (RANDBETWEEN) ,teria alguma maneira de fazer isso sem esta função?obrigado

Re: Modificar o horário de células em uma seleção via VBA

Enviado: 07 Jan 2016 às 17:00
por daniexcel
Segue seu código
Espero ter ajudado
Código: Selecionar todos
Sub SegundosAleatorios()
' Macro criada pelo usuario daniexcel
' Através do forum gurudoexcel.com

If Second(Now()) > 51 Then
    ActiveCell.FormulaR1C1 = "51"
Else
 ActiveCell = Second(Now())
End If

ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = Int((ActiveCell.Offset(-1, 0) + 1) + Rnd() * (53 - ActiveCell.Offset(-1, 0)))
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = Int((ActiveCell.Offset(-1, 0) + 1) + Rnd() * (54 - ActiveCell.Offset(-1, 0)))
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = Int((ActiveCell.Offset(-1, 0) + 1) + Rnd() * (55 - ActiveCell.Offset(-1, 0)))
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = Int((ActiveCell.Offset(-1, 0) + 1) + Rnd() * (56 - ActiveCell.Offset(-1, 0)))
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = Int((ActiveCell.Offset(-1, 0) + 1) + Rnd() * (57 - ActiveCell.Offset(-1, 0)))
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = Int((ActiveCell.Offset(-1, 0) + 1) + Rnd() * (58 - ActiveCell.Offset(-1, 0)))
ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = Int((ActiveCell.Offset(-1, 0) + 1) + Rnd() * (59 - ActiveCell.Offset(-1, 0)))
ActiveCell.Offset(1, 0).Select

End Sub
Agora é só adequar a sua necessidade.
Abs

Modificar o horário de células em uma seleção via VBA

Enviado: 08 Jan 2016 às 20:51
por joaohenriquemc
Olá daniexcel, muito obrigado pela ajuda! irei adaptar ao meu código, to meio sem tempo agora pra ver os resultados, mas é de grande importancia pra mim a ajuda aqui prestada, vlw abraços. :D