Página 1 de 1

Copiar dados de uma aba para outra, com mudança de posição

Enviado: 29 Jul 2019 às 10:43
por Renandftb
Olá pessoal,

Trabalho na área de saneamento e preciso de uma ajuda para formatar uma tabela com dados de data, hora, vazão, velocidade e volume. Temos um datalogger em um medidor de vazão, registrando esses dados a cada 15 minutos. O datalogger grava os dados em um arquivo foramto txt. Até aí não é problema, pois é fácil para importar os dados. O problema é a forma como o datalogger registra os dados:

19-07-15 12:00:00
FLOW: 47.1847 m3/h
VEL: 0.723379 m/s
POS: +19x1 m3

19-07-15 12:15:00
FLOW: 47.7138 m3/h
VEL: 0.73149 m/s
POS: +31x1 m3

A minha dificuldade está em formatar em uma nova posição esses dados, dessa forma:

Data Hora Flow Vel POS
19-07-15 12:00:00 47.1847 0.723379 +19x1
19-07-15 12:15:00 47.7138 0.73149 +31x1

Será que uma macro poderia ajudar a formatar essa tabela nessa nova posição?

Segue planilha com os dados já importados (aba DADOS) e da forma com preciso (FORMATADO).

Re: Copiar dados de uma aba para outra, com mudança de posiç

Enviado: 29 Jul 2019 às 11:27
por eduardogrigull
Olá, resolvi com dois scripts.

Esse aqui formata os registros já existentes:
Código: Selecionar todos
Sub FormatarTudo()
Dim UltimaLinha As Integer

'Definir ultimo reg
UltimaLinha = Sheets("Dados").Range("A100000").End(xlUp).Row
   
'Loop
i = 1
While i <= UltimaLinha

    'Formatar
    Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row + 1, 1).Value = Sheets("Dados").Cells(i, 1).Value      'Data
    Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row, 2).Value = Sheets("Dados").Cells(i, 2).Value          'Hora
    Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row, 3).Value = Sheets("Dados").Cells(i + 1, 2).Value      'Vazao
    Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row, 4).Value = Sheets("Dados").Cells(i + 2, 2).Value      'Vel
    Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row, 5).Value = Sheets("Dados").Cells(i + 3, 2).Value      'Pos
    i = i + 5
Wend
End Sub
E esse aqui formata automaticamente novos registros, voce precisa colocar "Call FormatarUltimoRegistro" nas opcoes de "WorkSheet_Change"

Segue o código:
Código: Selecionar todos
Sub FormatarUltimoRegistro()
Dim UltimaLinha As Integer

'Definir ultimo reg
UltimaLinha = Sheets("Dados").Range("A100000").End(xlUp).Row
UltimaLinha = UltimaLinha - 3


'Verificar se o reg está completo
If Sheets("Dados").Cells(UltimaLinha, 1).Value = Empty Or Sheets("Dados").Cells(UltimaLinha, 2).Value = Empty _
    Or Sheets("Dados").Cells(UltimaLinha + 1, 2).Value = Empty Or Sheets("Dados").Cells(UltimaLinha + 2, 2).Value = Empty _
    Or Sheets("Dados").Cells(UltimaLinha + 3, 2).Value = Empty Or _
    Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row, 2).Value = Sheets("Dados").Cells(UltimaLinha, 2).Value Then
    
    Exit Sub
End If


'Formatar
Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row + 1, 1).Value = Sheets("Dados").Cells(UltimaLinha, 1).Value      'Data
Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row, 2).Value = Sheets("Dados").Cells(UltimaLinha, 2).Value          'Hora
Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row, 3).Value = Sheets("Dados").Cells(UltimaLinha + 1, 2).Value      'Vazao
Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row, 4).Value = Sheets("Dados").Cells(UltimaLinha + 2, 2).Value      'Vel
Sheets("Formatado").Cells(Sheets("Formatado").Range("A100000").End(xlUp).Row, 5).Value = Sheets("Dados").Cells(UltimaLinha + 3, 2).Value      'Pos

End Sub