Este fórum está sendo desativado

[TiagoReis]

Bom dia,

Eu criei uma macro que me importar o txt para o excel sem problemas. No entanto, a minha macro só funciona bem se eu previamente substituir "," por "." no ficheiro .txt. O que acontece (se nao substituir a "," por "," no txt) é que ele na importação por exemplo: 2,436 importar no excel 2436,0. Existe solução para no momento da importação ele fazer a substituição? Já tentei alguns comando de replace no vba mas não me resolvem o problema.

Segue link com os ficheiros

https://www.dropbox.com/sh/gbwpfvqqyrgc ... u78sa?dl=0

Atentamente,

Tiago Reis

[alexandrevba]

Bom dia!!

Então thiago, como eu disse, aqui tu pode postar o arquivo.

Compacte seu arquivo txt compactado.

Att

[TiagoReis]

Bom dia Alexandre,

Aqui vai.

Atentamente,

Tiago Reis

[alexandrevba]

Boa tarde!!

lembra do link que eu indiquei?
Tente para ver se é isso que você quer.

Código: Selecionar todos

Option Explicit

'Fonte:http://www.rondebruin.nl/win/s3/win022.htm
#If VBA7 Then
    Private Declare PtrSafe Function SetCurrentDirectoryA Lib _
        "kernel32" (ByVal lpPathName As String) As Long
#Else
    Private Declare Function SetCurrentDirectoryA Lib _
        "kernel32" (ByVal lpPathName As String) As Long
#End If

Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
    Dim lReturn As Long
    lReturn = SetCurrentDirectoryA(szPath)
    ChDirNet = CBool(lReturn <> 0)
End Function

Sub Get_TXT_Files()
'For Excel 2000 and higher
    Dim Fnum As Long
    Dim mysheet As Worksheet
    Dim basebook As Workbook
    Dim TxtFileNames As Variant
    Dim QTable As QueryTable
    Dim SaveDriveDir As String
    Dim ExistFolder As Boolean

    'Save the current dir
    SaveDriveDir = CurDir

    'You can change the start folder if you want for
    'GetOpenFilename,you can use a network or local folder.
    'For example ChDirNet("C:\Users\Ron\test")
    'It now use Excel's Default File Path

    ExistFolder = ChDirNet(Application.DefaultFilePath)
    If ExistFolder = False Then
        MsgBox "Error changing folder"
        Exit Sub
    End If

    TxtFileNames = Application.GetOpenFilename _
    (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

    If IsArray(TxtFileNames) Then

        On Error GoTo CleanUp

        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        'Add workbook with one sheet
        Set basebook = Workbooks.Add(xlWBATWorksheet)

        'Loop through the array with txt files
        For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)

            'Add a new worksheet for the name of the txt file
            Set mysheet = ActiveSheet 'Worksheets.Add(After:=basebook. _
                                'Sheets(basebook.Sheets.Count))
            On Error Resume Next
            mysheet.Name = Right(TxtFileNames(Fnum), Len(TxtFileNames(Fnum)) - _
                                    InStrRev(TxtFileNames(Fnum), "\", , 1))
            On Error GoTo 0

            With ActiveSheet.QueryTables.Add(Connection:= _
                        "TEXT;" & TxtFileNames(Fnum), Destination:=Range("A1"))
                .TextFilePlatform = xlWindows
                .TextFileStartRow = 1

                'This example use xlDelimited
                'See a example for xlFixedWidth below the macro
                .TextFileParseType = xlDelimited

                'Set your Delimiter to true
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = True

                'Set the format for each column if you want (Default = General)
                'For example Array(1, 9, 1) to skip the second column
                .TextFileColumnDataTypes = Array(1, 2)

                'xlGeneralFormat  General          1
                'xlTextFormat     Text             2
                'xlMDYFormat      Month-Day-Year   3
                'xlDMYFormat      Day-Month-Year   4
                'xlYMDFormat      Year-Month-Day   5
                'xlMYDFormat      Month-Year-Day   6
                'xlDYMFormat      Day-Year-Month   7
                'xlYDMFormat      Year-Day-Month   8
                'xlSkipColumn     Skip             9

                ' Get the data from the txt file
                .Refresh BackgroundQuery:=False
            End With
        ActiveSheet.QueryTables(1).Delete
        Next Fnum

        'Delete the first sheet of basebook
        On Error Resume Next
        Application.DisplayAlerts = False
        basebook.Worksheets(1).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0

CleanUp:

        ChDirNet SaveDriveDir

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If
End Sub

[TiagoReis]

Bom dia Alexandre,

Já tentei adaptar meu código, mas continuo com o mesmo problema.

Atentamente,

Tiago Reis

[alexandrevba]

Bom dia!!

Estranho

Eu preciso que poste o resultado pretendido, pois nas opções

Código: Selecionar todos

'xlTextFormat     Text             2

, está descrito formato, além do delimitador.

Att

[lfgomes]

Bom dia Tiago...

Vê se dessa forma te ajuda...

[TiagoReis]

Boa tarde Alexandre e lfgomes,

lfgomes obrigado pela sua dica, mas o problema mantém-se. Seu código funciona quando as colunas no txt esta separadas apenas por um espaço. No meu caso são múltiplos espaços.
Ex:
1 0,2222
2 22,333

ele importa perfeitamente.
O meu caso:

1 0,2222
2 22,333

Nao estou conseguindo definir o numero de espaços no codigo.

Atentamente,

Tiago Reis

[lfgomes]

Boa tarde Tiago...

Olhando sua última mensagem, onde você compara os números que mandei com os seus, aparentemente estão iguaizinhos...

Não consegui entender onde está a diferença.

[TiagoReis]

Bom dia lfgomes,

Desde já, muito obrigado pelo seu tempo.
O problema esta no numero de espaços. Quando inseri o comentário ele comeu o espaçamento entre os numeros.
Do genero.

Ele importa bem
Ex:
1 0,2222
2 22,333

No entanto, se for assim

1 (vários espaços) 0,2222
2 ( vários espaços) 22,333


Att,

Tiago Reis

[lfgomes]

Bom dia Tiago...

Tem como você me mandar o arquivo TXT do jeito que você está me dizendo ??? com todos esses espaços...

Assim eu posso tentar resolver uma solução pra isso...

Fico no aguardo...

[Reinaldo]

Se na importação voce souber qual o elemento da Array é numero, pode utilizar algo assim:

Código: Selecionar todos

Sub ImportarTXT()
    Dim Campos As Variant
    Dim Arquivo As String
    Dim i As Long, j As Long
    
    i = 2
    Arquivo = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")
    If Arquivo = "False" Then
    Exit Sub
    Else
    Open Arquivo For Input As #1
    While Not (EOF(1))
        Line Input #1, Linha
        Campos = Split(Linha, " ")
        For j = 0 To UBound(Campos)
            If j = 1 Then
            Cells(i, j + 1).Value = Format(CDec(Campos(j)), "#,##0.000") * 1
            Else
            Cells(i, j + 1).Value = Campos(j)
            End If
        Next
       i = i + 1
    Wend
    Close #1
    End If
         
End Sub

[Vidal]

Gomes, bom dia, amigão! De VBA não é comigo, mas vou te dar uma "idéia" que possa ajudar na resolução do problema do Tiago: A fórmula =ARRUMAR( texto ou n° da célula que contém o texto ) remove do texto todos os espaçamentos extras e deixa apenas um espaço por padrão. Não teria como adaptar essa funcionalidade dentro do seu código VBA ?

[lfgomes]

Gomes, bom dia, amigão! De VBA não é comigo, mas vou te dar uma "idéia" que possa ajudar na resolução do problema do Tiago: A fórmula =ARRUMAR( texto ou n° da célula que contém o texto ) remove do texto todos os espaçamentos extras e deixa apenas um espaço por padrão. Não teria como adaptar essa funcionalidade dentro do seu código VBA ?

Ótima idéia Vidal... mas para isso eu preciso que ele mande o arquivo TXT para eu fazer os teste...

[Vidal]

até que ele responda.. tente fazer o seguinte: Pegue o arquivo zipado que ele enviou lá no início do tópico.. abra e.. como tem dois arquivos, pegue somente o txt dele... o que contém os valores com apenas um espaçamento.. salve em sua área de trabalho..edite o arquivo vc mesmo e insira mais células de espaço entre os valores do arquivo... tente assim.. creio que resolve, salvo engano

[lfgomes]

Acabei de fazer isso Vidal...

Testei mudando o arquivo TXT dele para a forma que ele mencionou, com cada linha com espaços aleatórios...

Descobri que a forma que eu desenvolvi antes e adicionei, já faz por si só esse acerto de espaços a mais...

O próprio código quando separa as colunas, acerta as quantidades distintas por espaços, então não importa que eles estejam em quantidades diferentes por linha, o resultado sempre será o mesmo...

[TiagoReis]

Boa tarde galera,

O problema dos espaços esta resolvido, a adaptação ao meu código esta mal feita. O problema agora persiste no separador decimal. Ele só funciona direito para números inferiores a 1. Reparem que no valor -2,33078 ele esta importando 233,078.
O problema esta no separador decimal.
Att,

Tiago Reis

[lfgomes]

Tiago...

Para podermos te ajudar melhor, você precisa mandar um TXT com mais números e detalhar melhor qual o resultado final você que r obter com a importação...

[TiagoReis]

Boa tarde,

Analisemos o ficheiro:

Ficheiro Original:
B -0,18993
...
D 2,33078
E -3,41081
F -4,00842

O que ele esta a importar é:
B -0,18993
...
D 233,078
E -341,081
F -400,842

O que eu quero que ele importe é

B -0,18993
...
D 2,33078
E -3,41081
F -4,00842

O ficheiro txt esta com virgulas. Se eu substituir as virgulas por pontos(antes de importar)ele funciona na perfeição. Ao importar ele transforma números de 2,333; 4,555 em 233,3 e 455,5 respetivamente.

Espero ter esclarecido melhor.

Att,

Tiago Reis

[lfgomes]

Tiago...

Manda o arquivo txt compactado... assim eu posso abri-lo no exemplo que eu fiz pra você e identificar onde está o erro...