2

Estou criando um código que irá automatizar os relatórios no trabalho a partir de um button. O equipamento de medição me da um arquivo em .mmf ou .txt, e tem uma parte importante que estou quebrando a cabeça para conseguir resolver e estou a uns dias sem avançar.

Abaixo é o texto que quero extrair, os dados (números separados por ponto e vírgula) sempre tem a mesma quantidade de colunas e as linhas variam de acordo com a medição feita. Quero descobrir a forma de retirar tudo que está entre "MWTTanDeltaValues=" até "MWTTanDeltaTimeValues=" e colar na planilha. Segue uma parte do arquivo contendo o trecho que necessito extrair (em negrito):

MWTTanDeltaMean=27.0355 MWTTanDeltaSTD=2.3498

MWTTanDeltaChangeOverTime=1.8083

MWTTanDeltaDuration= 15

MWTTanDeltaMeanPeakVoltage=34475.3700

MWTTanFrequency=0.1000

MWTTanDeltaValues=

27.5766;27.5707;27.3737;26.6112;26.0126;26.2416;26.1120; 26.1621;25.7420;25.9710;25.6238;25.7683;25.8689;26.1269; 26.1321;26.2643;25.7848;25.1501;25.3091;25.0000;25.3175; 25.5920;24.8733;24.6167;24.6299;24.7430;25.4183;25.9896; 25.4958;25.4259;26.4650;25.7657;30.0259;30.5261;30.2207; 30.7683;30.5524;31.4316;30.5092;31.2188;31.3513;31.4804; 31.1870;31.5287;31.2671;30.7482;29.5514;28.6546;29.6851; 29.2009;29.2151;29.1309;29.1466;33.0232;31.8877;30.4890; 26.8053;27.0559;26.8480;25.6997;25.8613;26.7863;26.0611; 26.7878;27.2462;25.6071;25.9075;25.9302;25.8017;26.8502; 26.7850;26.3517;25.5865;26.1033;25.8408;26.2310;25.0309; 23.9557;24.0468;24.0217;23.7751;24.5628;24.3670;24.3429; 25.5378;27.6765;24.4876;24.7278;23.9403;

MWTTanDeltaTimeValues=

25.8168;27.8008;27.0355;

MWTTanDeltaSTDTimeValues=

0.7685;2.4520;2.3498;

MWTTanDeltaChangeTimeValues=


[Result]

SmileyPhase1=3

Temperature=

MeasurementResult=0 TEST SEQUENCE COMPLETED SUCCESSFULLY

2017-12-27 14.08

Essa solução iria resolver qualquer outro problema que eu pudesse ter no futuro.

Agradeço desde já!

1 Resposta 1

1

Regex

Habilitar o Regex no Excel VBA

  1. RegEx precisa ser habilitado, Habilite o modo Desenvolvedor
  2. Na aba 'Desenvolvedor', clique em 'Visual Basic' e a janela do VBA irá abrir.
  3. Vá em 'Ferramentas' -> 'Referências...' e uma janela abrirá.
  4. Procure por 'Microsoft VBScript Regular Expressions 5.5', como na imagem abaixo. E habilite esta opção.

Janela Referências

Padrão

Um Regex simples que identifica um grupo que está entre MWTTanDeltaValues= e MWTTanDeltaTimeValues=:

MWTTanDeltaValues=\s*([\s\S]+)(?=MWTTanDeltaTimeValues=)

Demo no Regex101

Código VBA

Encontrar arquivo txt e retirar string

Encontra o arquivo definido ou se não encontrar o usuário escolhe o arquivo. Abre o .txt e encontra a String desejada.

Sub EncontrarTXT()

Dim objStream As Object
Dim strData As String
Dim fileName As String, textData As String, fileNo As Integer
sFilename = "teste.txt"
'    sFilename = Sheets("Planilha1").Range("A1")
sFilepath = ThisWorkbook.Path & "\" & sFilename
fileNo = FreeFile                            'Get first free file number


Inicio:
If Dir(sFilepath) <> "" Then
    Open sFilepath For Input As #fileNo
    strData = Input$(LOF(fileNo), fileNo)

    Dim objMatches As Object, objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    'Regex https://regex101.com/r/gXOEV9/1
    objRegExp.Pattern = "MWTTanDeltaValues=\s*([\s\S]+)(?=MWTTanDeltaTimeValues=)"
    objRegExp.Global = True

    Set objMatches = objRegExp.Execute(strData)
    If objMatches.Count <> 0 Then

        For Each m In objMatches
            'Imprime na janela de Verificação Imediata
'                Debug.Print m.Submatches(0)
            'Preenche a célula A1 da planilha Planilha1
'                Sheets("Planilha1").Range("A1") = m.Submatches(0)
        Next m
    End If
Else
    MsgBox "O arquivo txt não pôde ser carregado - Escolha o caminho."
    sFilepath = EscolherArquivo
    If Dir(sFilepath) <> "" Then GoTo Inicio
End If
'Close
Close #fileNo

End Sub

Escolher Arquivo

Caso não encontre o caminho referido no código, uma janela será aberta para escolher o arquivo no sistema.

Public Function EscolherArquivo() As String
'Créditos: http://software-solutions-online.com/excel-vba-open-file-dialog/
Dim intChoice As Long
Dim strPath As String

'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
    'get the file path selected by the user
    strPath = Application.FileDialog( _
              msoFileDialogOpen).SelectedItems(1)
    'print the file path to sheet 1
    EscolherArquivo = strPath
End If
End Function

Resultado

É esta String:

27.5766;27.5707;27.3737;26.6112;26.0126;26.2416;26.1120; 26.1621;25.7420;25.9710;25.6238;25.7683;25.8689;26.1269; 26.1321;26.2643;25.7848;25.1501;25.3091;25.0000;25.3175; 25.5920;24.8733;24.6167;24.6299;24.7430;25.4183;25.9896; 25.4958;25.4259;26.4650;25.7657;30.0259;30.5261;30.2207; 30.7683;30.5524;31.4316;30.5092;31.2188;31.3513;31.4804; 31.1870;31.5287;31.2671;30.7482;29.5514;28.6546;29.6851; 29.2009;29.2151;29.1309;29.1466;33.0232;31.8877;30.4890; 26.8053;27.0559;26.8480;25.6997;25.8613;26.7863;26.0611; 26.7878;27.2462;25.6071;25.9075;25.9302;25.8017;26.8502; 26.7850;26.3517;25.5865;26.1033;25.8408;26.2310;25.0309; 23.9557;24.0468;24.0217;23.7751;24.5628;24.3670;24.3429; 25.5378;27.6765;24.4876;24.7278;23.9403;

Explicação

  • sFilename = "teste.txt"

String que define o nome do arquivo

  • sFilepath = ThisWorkbook.Path & "\" & sFilename

String que define o caminho do arquivo, em que é a concatenação do caminho do arquivo atual do Excel & o nome do arquivo.

  • Inicio:

Marca o início do código

  • If Dir(sFilepath) <> "" Then

Se o diretório definido em sFilepath for encontrado, segue o código para abrir o txt e extrair a String.

  • Else

Caso Contrário...

  • sFilepath = EscolherArquivo

O usuário escolhe o arquivo a ser usado, chamando a função EscolherArquivo

  • GoTo Inicio

Depois de escolher o arquivo, volta ao Inicio:

  • Open sFilepath For Input As #fileNo

Abre o arquivo txt

  • strData = Input$(LOF(fileNo), fileNo)

Define a String strData com os dados do arquivo txt.

  • Dim objMatches As Object, objRegExp As Object: Set objRegExp = CreateObject("VBScript.RegExp"):'Regex https://regex101.com/r/gXOEV9/1 : objRegExp.Pattern = "MWTTanDeltaValues=\s*([\s\S]+)(?=MWTTanDeltaTimeValues=)" : objRegExp.Global = True

Define os parâmetros da Regex.

  • Set objMatches = objRegExp.Execute(strData)

Executa a Regex na String strData

  • If objMatches.Count <> 0 Then

Se algum resultado da regex for encontrado, então...

  • For Each m In objMatches: Next m

Para cada match encontrado na Regex

  • Debug.Print m.Submatches(0)

Imprime na Verificação Imediata o grupo 1 do Match

  • Sheets("Planilha1").Range("A1") = m.Submatches(0)

Preenche a célula A1 da planilha Planilha1

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .