Excel Importar arquivos muito grande dando continuidade e novas planilhas

[Janilson Brito]

Senhores, bom dia!

Precisando de ajuda, tenho um arquivo em *.txt que a quantidade e linhas é maior que o excel suporta, fazendo algumas pesquidas achei uma macro que me ajudou muito, porém ainda não consegui chegar no resultado esperado.

Inseri uma parte do arquivo para explicar o layout, a informacao que preciso deste arquivo é onde esta o campo APLICACAO (sem o que esta apos o ponto) e o campo INICIO. segue abaixo o que preciso importar para o excel.

tentei usar a macro abaixo, funciona criando novas planilhas, porém quando ele importa vem a linha toda como uma unica celula.

tentei fazer uma macro a parte para importar somente o que preciso, fucionou, mas não estou conseguindo unificar as duas, ou algo parecido.

AGENTE                APLICACAO                                           INICIO               FIM                  JOB                                                                           TYPE    STATUS                        ---------------- --------------------------------------------------- -------------------- -------------------- ----------------------------------------------------------------------------- ------- --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- 
AGT_TCH01NH   DES_DIARIO_CICLICO_15.60165     2022-09-20 17:03:56  2022-09-20 17:04:19  WORKFLOW_STEP005_DOWNGRADE/1                                             UNIX    COMPLETE/0/

AGT_TCH01NH   DES_DIARIO.60165          2022-09-20 17:03:56  2022-09-20 17:04:19  WORKFLOW_STEP005_DOWNGRADE/1 UNIX    COMPLETE/0/

 

Esta macro consegui adaptar ao que preciso porém, sem sucesso em trazer apenas os dados que preciso.

Sub ImportarTextosGrandes()
    Dim ultimaFila, fila, contador As Long
    Dim linea, NomeArquivo As String
    'Calcula a última linha da planilha
    Selection.End(xlDown).Select
    ultimaFila = Selection.Row
    Selection.End(xlUp).Select
    Set oSistemaArquivo = CreateObject("Scripting.FileSystemObject")
    'Nome do arquivo a importar
    NomeArquivo = "C:\temp\REL_APLICACOES.txt"
    Set arquivo = oSistemaArquivo.OpenTextFile(NomeArquivo, 1, False, -2)
    fila = 1
    contador = 1
          Do While arquivo.AtEndOfStream <> True
        linea = arquivo.ReadLine
        Cells(fila, "a").Value = linea
        'Atualiza barra de status
        Application.StatusBar = "Lendo linha número = " & contador
        fila = fila + 1
        contador = contador + 1
        'Cria nova planilha quando planilha atual está cheia
        If fila > ultimaFila Then
            Worksheets.Add after:=ActiveSheet
            fila = 1
        End If
    Loop
End Sub

 

Esta macro montei tranzendo somente o que preciso

Sub Colunas()

With ActiveSheet.QueryTables.Add(Connection:= _
                "TEXT;K:\JANILSON\Projetos\DSERIES - EVENTOS APLICACOES EXCLUIDAS\HMG\REL_APLICACOES.txt" _
                , Destination:=Range("$A$2"))
                .Name = "REL_APLICACOES_2"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 850
                .TextFileStartRow = 5
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = True
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = True
                .TextFileOtherDelimiter = "."
                .TextFileColumnDataTypes = Array(9, 1, 9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
                9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9 _
                , 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With

End sub

REL_APLICACOES_clube.txt REL_APLICACOES_clube.rar

[Midori]

@Janilson Brito Com Split a macro pode pegar os campos necessários a partir da linha do arquivo. Veja se assim resolve,

Sub ImportarTextosGrandes()
    Dim Planilha        As Worksheet
    Dim oSistemaArquivo As Object
    Dim Arquivo         As Object
    Dim Campo           As Variant
    Dim TxtLinha        As String
    Dim NomeArquivo     As String
    Dim LinhaPlanilha   As Long
    Dim LinhaArquivo    As Long
    
    NomeArquivo = ThisWorkbook.Path & "\REL_APLICACOES_clube.txt"
    Set oSistemaArquivo = CreateObject("Scripting.FileSystemObject")
    Set Arquivo = oSistemaArquivo.OpenTextFile(NomeArquivo, 1, False, -2)
    Set Planilha = ThisWorkbook.Sheets("geral")
    
    Do While Arquivo.AtEndOfStream <> True
        TxtLinha = WorksheetFunction.Trim(Arquivo.ReadLine)
        
        If TxtLinha <> "" Then
            Campo = Split(TxtLinha, " ")
            If UBound(Campo) > 2 Then
                LinhaPlanilha = LinhaPlanilha + 1
                LinhaArquivo = LinhaArquivo + 1
                
                Planilha.Cells(LinhaPlanilha, "A").Value = _
                    IIf(InStr(Campo(1), "."), Split(Campo(1), ".")(0), Campo(1))
                
                Planilha.Cells(LinhaPlanilha, "B").Value = Campo(2) & " " & Campo(3)
                
                Application.StatusBar = "Lendo linha número = " & LinhaArquivo
            
                'Cria nova planilha quando planilha atual está cheia
                If LinhaPlanilha >= [A:A].Rows.Count Then
                    Set Planilha = ThisWorkbook.Worksheets.Add
                    LinhaPlanilha = 0
                End If
            End If
        End If
    Loop
    Arquivo.Close
End Sub

 

[Janilson Brito]

20 horas atrás, Midori disse:

@Janilson Brito Com Split a macro pode pegar os campos necessários a partir da linha do arquivo. Veja se assim resolve,

Sub ImportarTextosGrandes()
    Dim Planilha        As Worksheet
    Dim oSistemaArquivo As Object
    Dim Arquivo         As Object
    Dim Campo           As Variant
    Dim TxtLinha        As String
    Dim NomeArquivo     As String
    Dim LinhaPlanilha   As Long
    Dim LinhaArquivo    As Long
    
    NomeArquivo = ThisWorkbook.Path & "\REL_APLICACOES_clube.txt"
    Set oSistemaArquivo = CreateObject("Scripting.FileSystemObject")
    Set Arquivo = oSistemaArquivo.OpenTextFile(NomeArquivo, 1, False, -2)
    Set Planilha = ThisWorkbook.Sheets("geral")
    
    Do While Arquivo.AtEndOfStream <> True
        TxtLinha = WorksheetFunction.Trim(Arquivo.ReadLine)
        
        If TxtLinha <> "" Then
            Campo = Split(TxtLinha, " ")
            If UBound(Campo) > 2 Then
                LinhaPlanilha = LinhaPlanilha + 1
                LinhaArquivo = LinhaArquivo + 1
                
                Planilha.Cells(LinhaPlanilha, "A").Value = _
                    IIf(InStr(Campo(1), "."), Split(Campo(1), ".")(0), Campo(1))
                
                Planilha.Cells(LinhaPlanilha, "B").Value = Campo(2) & " " & Campo(3)
                
                Application.StatusBar = "Lendo linha número = " & LinhaArquivo
            
                'Cria nova planilha quando planilha atual está cheia
                If LinhaPlanilha >= [A:A].Rows.Count Then
                    Set Planilha = ThisWorkbook.Worksheets.Add
                    LinhaPlanilha = 0
                End If
            End If
        End If
    Loop
    Arquivo.Close
End Sub

 

Midori, mais uma vez muito obrigado, estou apredendo cada dia mais, e algumas ja consigo desenvolver sozinho.

agora, Janilson Brito disse:

Midori, mais uma vez muito obrigado, estou apredendo cada dia mais, e algumas ja consigo desenvolver sozinho.

@Midori mais uma vez muito obrigado, estou apredendo cada dia mais, e algumas ja consigo desenvolver sozinho.