Guru do Excel e Power BI

Olá, bom dia!


Por acaso alguém conhece uma boa macro para importar os .TXT do complexo SPED no Excel de forma organizada, permitindo a separação registro por registro?

Abs e obrigado!

Olá,

To na correria, mas espero conseguir ajudar , vou colocar uma ideia aqui amigo.

Dim vrTemp() As String
Function ExisteSheet(nome As String) As Boolean
Dim Sh As Worksheet
On Error Resume Next
Set Sh = Worksheets(nome)
If Sh Is Nothing Then ExisteSheet = False Else ExisteSheet = True
Set Sh = Nothing
End Function

Sub importarTxt()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.DisplayStatusBar = False

Dim Tempo As Double
Tempo = Now()

Dim strArquivo As Office.FileDialog
Dim strLinhaTexto As String
Dim intContItens As Integer, x As Integer

Set strArquivo = Application.FileDialog(msoFileDialogOpen)

With strArquivo
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Arquivos TXT", "*.txt"
.Title = "Selecione um ou mais arquivos"
.Show
End With
intContItens = strArquivo.SelectedItems.Count
If intContItens = 0 Then
MsgBox "Nenhum arquivo selecionado"
Exit Sub
End If
'abre o arquivo texto para leitura.
'Altere para o caminho e nome de seu arquivo
For x = 1 To intContItens
Open strArquivo.SelectedItems(x) For Input As #1

Do While Not EOF(1)
Line Input #1, strLinhaTexto
vrTemp = Split(strLinhaTexto, "|")
If ExisteSheet(vrTemp(1)) = True Then
incluinaplan (vrTemp(1))
Else
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = vrTemp(1)
incluinaplan (vrTemp(1))
End If
Loop
Close #1 'fecha o arquivo texto
Next
Sheets(1).Select

MsgBox "Concluido"
MsgBox Now() - Tempo
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.DisplayStatusBar = True

End Sub
Private Sub incluinaplan(ByVal strNome As String)
Dim intLinhaFim As Long, y As Long
intLinhaFim = Sheets(strNome).Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets(strNome)
For y = 1 To UBound(vrTemp)
.Cells(intLinhaFim, y) = "'" & vrTemp(y)
Next
End With
End Sub

Quase esqueci, todos os créditos vão para o incrível Reinaldo que ajuda aqui como no site do Tomaz. Grande abraço a esse profissional.

Caso precise puxar um campo especifico e vai dar um erro por causa da assinatura do SPED que consegue sanar com essa programação.


' funcao para importar sómente o campo C100 ----------'
Do While Not EOF(1)
Line Input #1, strLinhaTexto
vrTemp = Split(strLinhaTexto, "|")

'Alteração do código começa aqui
If vrTemp(1) = "9999" Then
Exit Do
End If
'Fim da alteração do código

If VarType(strLinhaTexto) <> 1 Then
If vrTemp(1) = "C100" Then 'Verifica se o codigo corresponde ao esperado
If ExisteSheet(vrTemp(1)) = True Then
incluinaplan (vrTemp(1))
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = vrTemp(1)
incluinaplan (vrTemp(1))
End If
End If
End If
Loop
'------------------------------------------------------'

Essa macro do campo específico deve ser adicionado em um novo módulo ou deve ser colado dentro da macro inicial?