............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

Eliminar Retornos de Carro, Enter, asc(10) o asc(13) dentro de un archivo .txt

Ver el tema anterior Ver el tema siguiente Ir abajo

Eliminar Retornos de Carro, Enter, asc(10) o asc(13) dentro de un archivo .txt

Mensaje por Tinno el Miér Mar 30, 2011 12:11 pm

Hola Excelusuarios de este Foro, recurro a su ayuda para resolver este pequeño problema que me esta sacando canas verdes, ya que necesito eliminar de varios archivos el enter (o varios) que contenga dentro de una linea, por que, por ejemplo, tengo un archivo (claro.txt) en el cual contiene mas de 23883 ó más registros, solo que al abrirlo en excel me marca que el archivo no esta completamente cargado, (bueno, mi version es 2003, así que solo cuento con 65536 filas) entonces con estos Enters (◙) entiende excel que es una nueva linea, bueno creo que ya me estoy mareando de nuevo con todo esto.

Ya intente abrir el archivo via código, solo que si la linea 1 tiene dos enters(◙) y delante de estos mismos tengo texto, me los pone como una linea nueva, dejando como resultado la linea 1 dividida en linea 2 y 3, ejemplo:

RACTIVO(◙) 17/01/2011(◙)POLIZA 10893926 FOLIO MJR 4175019 JRA

como resultado me da:

RACTIVO
17/01/2011
POLIZA 10893926 FOLIO MJR 4175019 JRA

el resultado que quiero es:

RACTIVO 17/01/2011 POLIZA 10893926 FOLIO MJR 4175019 JRA

Espero me puedan ayudar, os dejo los códigos que eh intentado sin obtener dicho resultado, y antes de terminar, su ayuda y el tiempo que inviertan se los puedo pagar solo con un enorme GRACIAS. okas... TINNO


Código 1:

Código:
Option Explicit
Dim Infile As Integer
Dim Outfile As Integer

Sub Process()
Dim Stline As String, StinStr As String
Infile = FreeFile
    Open "C:\Users\usuario\Documents\For\OCURREN20110202000000001.txt" For Input As #Infile
    Outfile = FreeFile
    Open "C:\Users\usuario\Documents\For Marsh\noblanks.txt" For Output As #Outfile
Do Until EOF(Infile)
  Input #Infile, Stline
  Cells(1, 1).Value = Stline
  On Error Resume Next
  Cells(2, 1).Value = "=Excel.Application.WorksheetFunction.Replace(rc[-1], Asc(13), "")"
  On Error GoTo 0
    StinStr = Cells(2, 1).Value
  Write #Outfile, StinStr
Loop
 Close #inFile
 Close #outFile
End Sub

Código 2:


Código:
Option Explicit
Sub Afrik_Unite()
  Dim Fnm As Variant, celda As Variant, msgInp As Variant, TtlInp As Variant, optInp As Variant, CLD As Variant
  Dim FNu As Integer, Cha As Integer
  Dim RFNm As String, WbB As String, Nrep As String, KRCT As String, nw As String, IFNm As String
  Dim Counter As Double
  Dim Rango As Range
  Dim AhoM As Long, I As Long
    msgInp = "Open Txt of " & vbCrLf & " all Documents in..."
    TtlInp = "Open File Txt"
    optInp = "C:\My Documents\Commander"
      SendKeys "{END}"
    IFNm = InputBox(msgInp, TtlInp, optInp)
    Fnm = Dir(IFNm & "\*.txt")
      FNu = FreeFile()
        Workbooks.Add Template:=xlWorksheet
        WbB = ActiveWorkbook.Name
    On Error GoTo ErrorHere
    Do
    AhoM = 1
        Open IFNm & "\" & Fnm For Input As #FNu
            Counter = 1
            Do While Seek(FNu) <= LOF(FNu)
            Line Input #FNu, RFNm
            If Cells(1, 1).Value <> "" Then AhoM = Cells(Rows.Count, "A").End(xlUp).Row + 1
                  For I = 1 To Len(RFNm)
                  Select Case Asc(Mid(RFNm, 1, I))
                  Case 10, 13
                  GoTo Siguiente
                  Case Else
                    With Cells(AhoM, "A")
                          .Select
                          .Value = RTrim(Mid(RFNm, 1, I))
                    End With
                  End Select
Siguiente:
                  Next
            If ActiveCell.Row = 65535 Then Sheets.Add
                Counter = Counter + 1
            Loop
            AhoM = ""
        Close
            On Error Resume Next
            Fnm = Dir()
    Loop Until Fnm = ""
    GoTo Finaliza
ErrorHere:
    Stop
Finaliza:
MsgBox "Okas", vbInformation
End Sub



Tinno

Masculino Cantidad de envíos : 8
Edad : 33
Ciudad - Pais : México, D.F.
Version de Excel : 2003-2007
Fecha de inscripción : 15/02/2011

Volver arriba Ir abajo

Re: Eliminar Retornos de Carro, Enter, asc(10) o asc(13) dentro de un archivo .txt

Mensaje por GalileoGali el Jue Mar 31, 2011 1:50 pm

Código:
Sub procesar()
Dim fs As New FileSystemObject
Dim txf As File
Dim txStream As TextStream
Dim strTXF As String

Set txf = fs.GetFile("C:\Documents and Settings\XP\Escritorio\test asc(13).txt")
Set txStream = txf.OpenAsTextStream(ForReading, TristateUseDefault)

strTXF = txStream.ReadAll
txStream.Close
strTXF = Replace(Replace(strTXF, Asc(13), Asc(32)), Asc(10), Asc(32))
Set txStream = txf.OpenAsTextStream(ForWriting, TristateUseDefault)
txStream.Write (strTXF)
txStream.Close
End Sub
Omiti indicar que en el Editor de VBA, en Herramientas >> Referencias hay que habilitar "Microsoft Scripting Runtime"


Última edición por GalileoGali el Mar Abr 05, 2011 8:10 am, editado 4 veces

_________________
GalileoGali
M.A.P. 2010-2013
Microsoft Active Professional
avatar
GalileoGali
Admin

Masculino Cantidad de envíos : 1962
Edad : 61
Ciudad - Pais : QUIROGA, Argentina
Version de Excel : 2000-2003-2007-2010
Fecha de inscripción : 24/01/2008

http://excelgali.mejorforo.net

Volver arriba Ir abajo

Re: Eliminar Retornos de Carro, Enter, asc(10) o asc(13) dentro de un archivo .txt

Mensaje por Tinno el Jue Mar 31, 2011 2:54 pm

Nueva mente, GRACIAS, lo eh aplicado y me funciona.

Y yo con tanto código.

Okas...

Tinno

Masculino Cantidad de envíos : 8
Edad : 33
Ciudad - Pais : México, D.F.
Version de Excel : 2003-2007
Fecha de inscripción : 15/02/2011

Volver arriba Ir abajo

Resuelto

Mensaje por Tinno el Lun Abr 04, 2011 5:00 pm

Anexo el código final de toda esta arte de eliminar Retornos de carro dentro de archivos .txt, solo insertas la carpeta donde estan todos los txt, para que esten todos en un solo (.txt) sin retornos de carro.
Bueno ahí les va para que lo modifiquen a sus necesidades y libre de sugerencias o mejoras.

Gracias * 1, 000 a todos.

Código:
Option Explicit
Public Drct As String
Sub OpenFilesTXT()
Rem
Dim FSO As New FileSystemObject
Dim VctFile() As Variant, VctTR() As Variant, Fnm As Variant, Onefile As Variant
Dim Fnu As Integer
Dim countEr As Long
Dim X, StinStr As String, Nnewfile As String, Carp As String, NewFile As String
Rem
  Nnewfile = "RESULTADO" & Format(Date, "#") & Format(Time, "hhmmam/pm") & ".txt"
Rem
 SendKeys "{END}"
  Drct = InputBox("Directorio de archivos .txt", "Unite Files", "C:\Documents and Settings\Cflorent\My Documents\Commander")
 If Drct = "" Then End
  Carp = Drct & "\Resultado"
 If FSO.FolderExists(Carp) = False Then FSO.CreateFolder (Carp)
  Application.Wait Now + TimeValue("00:00:03")
    NewFile = Carp & "\" & Nnewfile
 If FSO.FileExists(NewFile) = False Then FSO.CreateTextFile (NewFile)
  Fnm = Dir(Drct & "\*.txt")
    Fnu = FreeFile()
    Dim Outfile  As Integer
 Outfile = FreeFile()
  Open NewFile For Output As #Outfile
      Do
        countEr = 1
        Set Onefile = FSO.OpenTextFile(Drct & "\" & Fnm, 1)
          Onefile.SkipLine
        Do
            Cells(1, 1).Value = RTrim(Onefile.readline())
            If Onefile.AtEndOfStream = True Then GoTo sALDOS
              Call remplaZa
            StinStr = Cells(1, 1).Value
            Print #Outfile, StinStr
            countEr = countEr + 1
sALDOS:
        Loop Until Onefile.AtEndOfStream = True
          Onefile.Close
            Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).Value = Fnm & " tr: " & countEr - 1
            Cells(1, 1).Value = ""
          countEr = 0
        Set Onefile = Nothing
        Set FSO = Nothing
      On Error Resume Next
        Fnm = Dir()
      On Error GoTo 0
    Loop Until Fnm = ""
  Close #Outfile
 If IsError(CBool(Cells(2, 1).Value)) = False Then Cells(2, 1).Value = "Fin"
End Sub
Sub remplaZa()
 Dim i As Long, X As Long
 Dim rfnm As String
  rfnm = Cells(1, 1).Value
    For i = 166 To Len(rfnm)
      Cells(2, 1).Value = "=CODE(MID(R[-1]C, " & i & " ,1))"
      X = Cells(2, 1).Value
        Select Case X
                Case 10, 13
                      With Cells(1, "B")
                            .Select
                            .Value = "=REPLACE(RC[-1], " & i & " ,1,"";"")"
                      End With
                        Range("A1").Value = Range("B1").Value
                Case Else
                    With Cells(1, "B")
                            .Select
                            .Value = Mid(Cells(1, 1).Value, 1, i)
                    End With
                End Select
Siguiente:
    Next
                    Cells(1, "B").Value = ""
End Sub
 
Sub Cierra()
    Workbooks("Files Unite.xls").Close False
End Sub


Ah, por cierto, omite el encabezado y el último registro, = a: si el archivo tiene 13959 registros, toma del 2 hasta el 13958, también empieza a buscar los retornos de carro apartir del caracter 166, hasta el final de la linea.

Tinno ... Okas

Tinno

Masculino Cantidad de envíos : 8
Edad : 33
Ciudad - Pais : México, D.F.
Version de Excel : 2003-2007
Fecha de inscripción : 15/02/2011

Volver arriba Ir abajo

Re: Eliminar Retornos de Carro, Enter, asc(10) o asc(13) dentro de un archivo .txt

Mensaje por P@li el Vie Abr 29, 2011 10:52 pm

Hola que tal tanto tiempo, ni les cuento todo el tiempo que pase sin entrar al foro, pero bueno fue por muchas razones relacionadas con mi carrera y con el trabajo que se me hizo imposible, voy a tratar de participar un poco mas y arrancando queria hacer una mejora a la macro que aporto Gali, si Tinno está de acuerdo volverá a adaptar el código a su archivo.
Lo bueno de mi propuesta es que no usamos ninguna dll ajena a VBA, y tampoco es necesario habilitar referencias, lo que lo hace un poquito mas compatible con el resto de las máquinas y distintas versiones de excel.

Código:

Sub procesar()

Dim strTXF As String
dim path as String

path =  "C:\Documents and Settings\XP\Escritorio\test asc(13).txt"

'primero compruebo que el archivo exista
if dir(path)<>"" then

'abro el archivo como binario
Open path for binary as 1
'para leer el contenido del archivo es necesario darle
'la longitud exacta a la variable que vamos a usar
'para extraer los datos del archivo abierto
'y hay que tener muy en cuenta
'que esta variable tiene que estar declarada como string
'de lo contrario vamos a tener una variable variant
'que tiene una longitud variable
'y no funciona correctamente con este metodo
'de apertura, lectura y escritura de archivos
strtxf = splace(lof(1))
get #1,,strtxf
close 1

'al igual que Gali reemplazo todo lo que no sirve
strTXF = Replace(Replace(strTXF, Asc(13), Asc(32)), Asc(10), Asc(32))

'elimino el archivo original
kill path

'lo vuelvo a crear y escribo el nuevo contenido
Open path for binary as 1
put #1,,strtxf
close 1

end if

End Sub

Obviamente espero algun comentario del maestro!! un abrazo para todos!

Saludos,
Pablo.

P@li
Admin

Masculino Cantidad de envíos : 243
Edad : 33
Ciudad - Pais : Buenos Aires, Argentina
Version de Excel : Microsoft Excel 2002 (10.2614.2625)
Fecha de inscripción : 03/03/2008

Volver arriba Ir abajo

Re: Eliminar Retornos de Carro, Enter, asc(10) o asc(13) dentro de un archivo .txt

Mensaje por GalileoGali el Vie Abr 29, 2011 11:04 pm

Bienvewnido P@li!!!!!!!
Màs alla del caso en si mismo, P@li procura dejar sentado un principio que yo traducirìa asì: "Fijate si tienes azùcar en casa, antes de ir a buscar en otras casas"
algo semejante se presenta con las Funciones primitivas de Excel, son siempre preferibles (en la mayorìa de los casos) a cualquier UDF. En este caso serìa: "no es tan efciente acudir a una biblioteca externa teneiendo una solucion con las funciones nativas de VB?"

¡No sera SPACE en lugar de SPLACE ???????

_________________
GalileoGali
M.A.P. 2010-2013
Microsoft Active Professional
avatar
GalileoGali
Admin

Masculino Cantidad de envíos : 1962
Edad : 61
Ciudad - Pais : QUIROGA, Argentina
Version de Excel : 2000-2003-2007-2010
Fecha de inscripción : 24/01/2008

http://excelgali.mejorforo.net

Volver arriba Ir abajo

Re: Eliminar Retornos de Carro, Enter, asc(10) o asc(13) dentro de un archivo .txt

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.