Este fórum está sendo desativado

[GEOVANE775]

Boa tarde a todos! Estou tendo solucionar um problema de maneira automática, mas ainda não obtive sucesso.
tenho uma planilha com dados de chuva e sua respectiva hora de ocorrência. Quando está chovendo o pluviômetro registra dados de 10 em 10 minutos, mas quando para de chover ele registra dados de hora em hora para economizar energia do datalogger. Ou seja, quando não está chovendo ele registra o valor "zero" mm de hora em hora. Pois bem, criei uma rotina no R em que todos os dados deveriam estar de 10 em 10 minutos (Ex: 00:10, 00:20, 00:30, 00:40, 00:50, 01:00, 01:10, etc...) e não apenas quando chove (Ex: 00:10, 00:20, 00:30 "parou de chover", 01:30, 02:30, 03:30). Eu até poderia arrumar isso na mão, mas demoraria anos, uma vez que são 1500 pluviômetros com 30 anos de observação.
Colocarei a planilha de exemplo em anexo, nela tem a maneira como está, e a maneira como eu gostaria que ficasse.
Atenciosamente

[osvaldomp]

Segue uma solução via macro.
Instale uma cópia do código abaixo em um módulo comum, assim:
1. copie o código daqui
2. a partir da planilha em que estão os dados tecle 'Alt+F11' para acessar o editor de VBA
3. no menu do editor / Inserir / Módulo
4. cole o código na janela em branco que vai se abrir
5. feito! 'Alt+Q' para retornar para a planilha e testar

para rodar o código:
6. tecle 'Alt+F8' / selecione a macro correspondente / Executar, ou insira um botão na planilha e vincule-o à macro ou vincule-a a um atalho de teclado (Alt+F8 / Opções).

Código: Selecionar todos

Sub InsereHoras()
 Dim k As Long
  Application.ScreenUpdating = False
  If [F3] <> "" Then Range("F3:H" & Cells(Rows.Count, 6).End(3).Row).Value = ""
  Range("A4:C" & Cells(Rows.Count, 1).End(3).Row).Copy [F3]
  Columns(7).TextToColumns
  If Evaluate("=MOD(G3,1)") > #12:10:00 AM# Then [F3:H3].Insert Shift:=xlDown: [F3].Resize(, 3).Value = Array([F4], #12:10:00 AM#, 0)
  [F4:H4].Copy:  [F3].PasteSpecial xlFormats
  k = 4
   Do
    If Format(Evaluate("=MOD(" & Cells(k, 7).Address & "-" & Cells(k - 1, 7).Address & ",1)"), "hh:mm:ss") > #12:10:00 AM# Then
     Cells(k, 6).Resize(, 3).Insert Shift:=xlDown
     Cells(k, 6).Resize(, 3).Value = Array(Cells(k + 1, 6), Cells(k - 1, 7) + #12:10:00 AM#, 0)
    End If
    k = k + 1: If Cells(k , 7) = "" Then Exit Do
   Loop
  Application.ScreenUpdating = True
End Sub

obs.
1. o resultado será colocado a partir de F3
2. antes de rodar o código desfaça a mesclagem de células F1:H1