UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se puede subir archivos al foro, favor de hacerlo en servidor externo (Dropbox, Drive...) y dejan link. "Sin archivo no hay respuestas"

Favor de leer "Todos los temas" Click aquí.

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

1RESUELTO Unir TXTs en una hoja el 15/06/18, 03:58 pm

JOSEDAVILA


Hola, mi duda es una macro que una todos los txt del directorio, ya lo hace, pero cada txt en una sola celda, busco como separarlo por espacios definidos a manera de filas de registros uniendo todos los txt:
de esta manera necesito la información
     







002111111111111111111MXP0000999999999.00Garcia Ramirez Rocio20059940
014111111111111111111MXP0000999999999.00MACIAS GRAJEDA GENAROMACIAS GRAJEDA GENAR40
072111111111111111111MXP0000000050000.00ELVIA NELLY FERNANDEZ BUENTELLELVIA NELLY FERNANDE40
014111111111111111111MXP0000999999999.00Lorant Martinez Salas y Compan81026440
112111111111111111111MXP0000999999999.00Garcia Lespron Antonio240004440
002111111111111111111MXP0000999999999.00SHAMILL MORENO DOMINGUEZSHAMILL MORENO DOMIN40
021111111111111111111MXP0000000050000.00CENTRO MEDICO EXCEL SCCENTRO MEDICO EXCEL40
    


la macro actual es esta(solo me pega todos los libros en una misma celda):
Sub UnirTXT()
fila = 1
ruta = ActiveWorkbook.Path
destino = ActiveWorkbook.Name
ChDir ruta & "\"
archi = Dir("*.txt")
Do While archi <> ""
Open archi For Input As #1
contenido = Input(LOF(1), #1)
Workbooks(destino).Activate
Cells(fila, 1).Value = contenido
Close #1
fila = fila + 1
archi = Dir()
Loop
End Sub


intenté grabar la macro que necesito pero no se como integrar el código
Sub Macro3()
'
' Macro3 Macro
'

'
    Workbooks.OpenText Filename:= _
        "C:\Users\jodavila\Desktop\MACRO TES\CLABE 04.txt", Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(3, _
        1), Array(21, 1), Array(24, 1), Array(40, 1), Array(70, 1), Array(77, 1), Array(100, 1), _
        Array(102, 1)), TrailingMinusNumbers:=True
    Columns("B:B").ColumnWidth = 30.71
    Columns("B:B").Select
    Selection.NumberFormat = "0.00"
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
End Sub



o existirá otra manera?
gracias por su tiempo y ayuda

https://drive.google.com/open?id=1t20Pw6ezAf6wALYnQFcuEYoHJesLeF6E

2RESUELTO Re: Unir TXTs en una hoja el 15/06/18, 11:02 pm

Igtelo

avatar
Hola José.

Una variante para obtener los datos .txt, motivo:Que no siempre sea igual.
Este archivo y los de texto deben estar en misma carpeta, en el enlace sólo está el libro de trabajo...
Código:
Sub ArchivosTexto()
Dim ruta, archivo As String, w As Range

Application.ScreenUpdating = False
Cells.Clear   'Limpia la hoja
ruta = ThisWorkbook.Path & "\"  'La ruta
ChDir ruta                           'Redirecciona a la ruta
archivo = Dir("*.txt")          'Para archivos con extensión .txt
Do While archivo <> ""        'Hacer mientras haya archivos
Set w = ThisWorkbook.Sheets(1).Range("A" & [A90000].End(xlUp).Row)  'Fija éste libro y encuentra última celda vacía
Workbooks.OpenText ruta & archivo, DataType:=1, Tab:=True    'Abre cada archivo y pega datos en libro temporal
[A1].Resize(1000).Copy w      '<== Datos del libro temporal los copia y pega al libro fijo. Le di rango para mil, ajusta si son más de mil
Workbooks(archivo).Close False   'Cierra el archivo o libro de texto
archivo = Dir()   'Se pasa al siguiente archivo
Loop                  'Repite hasta terminar

With Range("A1", [A1].End(xlDown)) 'Con el rango...
 .Replace "40*", "40"         'Reemplaza espacios sobrantes a la derecha del 40

'Usamos texto en columnas...
 .TextToColumns [A1], DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(21, 1), Array(24, 1), Array(40, 1), _
    Array(70, 1), Array(100, 1)), TrailingMinusNumbers:=True

Columns("B:B").NumberFormat = "0"  'Formato de número
Cells.EntireColumn.AutoFit  'Ajusta columnas
[A1].Activate
End With
Application.ScreenUpdating = True
End Sub

Link:    [url=https://www.dropbox.com/s/4wfiegul2t28gxr/Igtelo-Jose Davila-Archivos]https://www.dropbox.com/s/4wfiegul2t28gxr/Igtelo-Jose%20Davila-Archivos%20txt.xlsm?dl=0[/url]

Ejecútala por pasos (tecla F8 dentro de VBA) y vas viendo lo que hace...

Saludos
Ignacio Téllez

3RESUELTO Re: Unir TXTs en una hoja el 18/06/18, 09:52 pm

Igtelo

avatar
Resuelto y cierro por abandono.

Ignacio Téllez

Contenido patrocinado


Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

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