COLOCAR ESPACO ENTRE INTENS ARQUIVO TXT

PAYDANA 06/05/2013 03:34:02
#422981
Pessoal achei bastante na internet de como remover espaços de strings mais nada do que eu preciso que é colocar espaços entre elas

tenho um arquivo com milhares de linhas assim
010203 060709 111213 161720 212425
010203 060709 111213 161720 222324
010203 060709 111213 161720 222325
010203 060709 111213 161720 222425
010203 060709 111213 161720 232425
010203 060709 111213 161819 212223

preciso converte-las para

01 02 03 06 07 09 11 12 13 16 17 20 21 24 25
01 02 03 06 07 09 11 12 13 16 17 20 22 23 24
01 02 03 06 07 09 11 12 13 16 17 20 22 23 25

Porque estou tendo problema quando mando procurar por exemplo o 20
Neste caso aqui 010203 é 02 e ele acusa 20
Dai o porque de eu querer colocar espaços em todos
NETMANIA 06/05/2013 08:41:51
#422983
Se o arquivo sempre tem um mesmo padrão, você pegar cada linha do arquivo, usar o comando MID para pegar os trechos e salvar em uma variável para salvar em novo arquivo.

Exemplo

stLinhaOriginal = [Ô]010203 060709 111213 161720 212425[Ô]
stLinhaFormatada = mid(stLinhaOriginal, 1, 2) & [Ô] [Ô] & mid(stLinhaOriginal, 3, 2) & [Ô] [Ô] & mid(stLinhaOriginal, 5, 2) & [Ô] [Ô]

Outra ideia, é colocar as posições em um vetor e usar um laço para ler os trechos necessários.

Espero que o exemplo e a ideia acima lhe ajudem.
EXPERT 06/05/2013 08:46:16
#422984 Resposta escolhida
Olá,

Fiz um exemplo aqui, espero que ajude

      Dim file As Integer
    Dim linha As String
    Dim i As Integer
    Dim linhaAux As String
    Dim resultado As String
    
    file = FreeFile
            
    Open [Ô]C:    este.txt[Ô] For Input As #file
    
    Do Until EOF(file)
        Input #file, linha
        
        linha = Replace(linha, [Ô] [Ô], [Ô][Ô])
        
        For i = 1 To Len(linha)
            If (i Mod 2 = 0) Then
                linhaAux = linhaAux & Left(linha, 2) & [Ô] [Ô]
                linha = Right(linha, Len(linha) - 2)
            End If
        Next
        
        resultado = resultado + linhaAux + vbCrLf
        linhaAux = [Ô][Ô]
    Loop

    Close #file
    
    Debug.Print resultado


Com toda certeza vc terá que adaptar o código a sua necessidade, mas espero q sirva de base.

Forte abraço, fique com Deus.
MARCELO.TREZE 06/05/2013 08:53:28
#422985
existe [ô]n[ô] situações ai.

primeiro é: [Ô]é você que gera estes números?[Ô]

depois é a maneira que você usa para buscar o numero.

porém nada é impossível, existe a maneira mais fácil e a mais difícil de se fazer isso.

a mais difícil é você alterar toda string, converter em uma array, e depois monta-la novamente

e a mais fácil é você retirar todos os espaços e buscar por pares

exemplo

Dim Numeros As String
Numeros = [Ô]010203 060709 111213 161720 212425[Ô]
Numeros = Replace(Numeros, [Ô] [Ô], [Ô][Ô])
For f = 1 To Len(Numeros) Step 2
If Mid(Numeros, f, 2) = [Ô]02[Ô] Then
MsgBox [Ô]o numero exitse na sequencia[Ô]
End If
Next f


ou seja o código acima vai buscar em pares o numero procurado evitando o erro que você descreveu

outro exemplo

Dim Numeros As String
Numeros = [Ô]010203 060709 111213 161720 212425[Ô]
Numeros = Replace(Numeros, [Ô] [Ô], [Ô][Ô])
For f = 1 To Len(Numeros) Step 2
MsgBox Mid(Numeros, f, 2), vbInformation, [Ô]Numeros na sequencia[Ô]
Next f


que mostra dezena por dezena no msgbox
PAYDANA 06/05/2013 09:29:34
#422986
Marcelo Treze O programa que uso pra remover as linhas que eu pesquiso aqui , não tenho codigo dele, nem em vb6 é, mais com essas sua ajuda ae ja to e pensando em fazer 1

Expert, seu codigo testei aqui e não mudo nada no txt

estou estudando mais ele aqui
PAYDANA 06/05/2013 09:41:47
#422987
EXPERT, FIZ TESTES AQUI com msgbox e seu codigo ta certo, so que ele nao altera o txt
EXPERT 06/05/2013 10:18:00
#422989
Entao, eu recomendo criar um novo txt ...

mas se for o caso ...

adicione no final do exemplo anterior

  
    Open [Ô]C:    este.txt[Ô] For Output As #1
    Print #1, resultado    [ô]Variável com o texto formatado
    Close #1


Espero ter ajudado, fique com Deus.
PROFESSOR 06/05/2013 11:52:51
#422996
Em resumo, você recebe um arquivo de texto com vários dígitos (números) e, indiferentemente do valor que possam á princípio representar, você precisa agrupar todo o conteúdo em pares de dígitos, ou melhor, em dezenas.
Definido o problema, resta implementar os passos para a solução, coisa que o EXPERT está fazendo de forma exemplar, ainda que eu prefira usar a FSO para lidar com arquivos.

Aí aparece o SEGUNDO problema, que é, como exposto por você, salvar o arquivo com as linhas já processadas.
Basicamente trata-se de fazer um pequeno apêndice, um minúsculo complemento ao código do EXPERT, apenas para salvar o texto contido na variável [Ô]resultado[Ô]. Se preferir, [Ô]mate[Ô] o arquivo original antes de salvar o resultado, como em:

[ô]...
   If Len(Trim$(Dir$([Ô]C:    este.txt[Ô]))) Then Kill [Ô]C:    este.txt[Ô]
   #file = FreeFile()
   Open [Ô]C:    este.txt[Ô] For Output As #file
   Print #file, resultado
   Close #file
[ô]...


Usando a FSO (referenciar File System Objects, que aparece na lista de componentes sob o nome [Ô]Microsoft Scripting Runtime[Ô], arquivo SCRRUN.DLL, ao projeto), seria algo como:

[ô]...
Dim fso     As FileSystemObject
Dim ts       As TextStream
Dim tmpS As String
Dim tmpP As String
Dim iLen   As Long
[ô]...
[ô] Leitura do arquivo
[ô]...
Set fso = New FileSystemObject
Set ts = fso.OpenTextFile([Ô]C:    este.txt[Ô], ForReading)
tmpS = ts.ReadAll
ts.Close
[ô]...
[ô]Já foi carregado, se pudermos apagar, fica assim: 
[ô]...
Call fso.DeleteFile([Ô]C:    este.txt[Ô], True)
[ô]...
[ô] Processamento das linhas
[ô]...
For iLen = 1 To Len(tmpS) 
      tmpP = tmpP & Trim$(Mid$(tmpS, iLen, 1))
      If ((Len(tmpP) Mod 2) = 0) Then tmpP = tmpP & [Ô] [Ô]
Next 
[ô]...
[ô] Gravação do resultado (veja, se não existir, o método cria o arquivo - último parâmetro como [ô]True[ô])
[ô]...
Set ts = fso.OpenTextFile([Ô]C:    este.txt[Ô], ForWriting, True)
ts.Write tmpP
ts.Close
[ô]...
[ô]Esvaziar os ponteiros de arquivo
[ô]...
Set ts = Nothing
Set fso = Nothing
[ô]...


Novamente, devo salientar que o código do EXPERT está ótimo, apenas apresento uma alternativa á ele.
PAYDANA 06/05/2013 12:00:17
#422997
Obrigado a todos!
Tópico encerrado , respostas não são mais permitidas
Voltar