Abrir txt largo con macros
Buenas tardes,
Tengo la siguiente macro para abrir un fichero .txt. Con el excel
Sub Abrir_y_DividirEnComumnas()
Dim strNombreArchivo
strNombreArchivo = Application.GetOpenFilename
If strNombreArchivo = False Then Exit Sub
Workbooks.OpenText _
Filename:=strNombreArchivo, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=True, _
Other:=False, _
FieldInfo:=Array(1, 1)
End Sub
Esta macro lo que me hace es abrir un fichero de texto que tiene como dos columnas:
0,0000E+0 -4,3786E+1
2,0000E+0 -2,3267E+1
4,0000E+0 -1,5706E+1
6,0000E+0 -2,0040E+1
8,0000E+0 -2,8482E+1
1,0000E+1 -1,1263E+1
En la columna "A" del excel me pone los valor de la primera columna y en la "B" el de la segunda. Hasta aquí, todo perfecto. El problema es que el archivo txt es muy largo, es decir, tiene un montón de filas. Entonces cuando lo abro con el excel cuando llega al número máximo de filas del excel ya no pone más valores.
Mi idea es que cuando llegue al tope de filas del excel se pase a la columna "C" y que siga poniendo los valores (unos en la columna C y otros en la D) hasta que termine de pasar todos los valores del txt.
Y si vuelve a llegar al máximo de filas, que se pase a la columna E y así sucesivamente.
¿Cómo podría hacer esto?
Muchas gracias
Saludos
Tengo la siguiente macro para abrir un fichero .txt. Con el excel
Sub Abrir_y_DividirEnComumnas()
Dim strNombreArchivo
strNombreArchivo = Application.GetOpenFilename
If strNombreArchivo = False Then Exit Sub
Workbooks.OpenText _
Filename:=strNombreArchivo, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=True, _
Other:=False, _
FieldInfo:=Array(1, 1)
End Sub
Esta macro lo que me hace es abrir un fichero de texto que tiene como dos columnas:
0,0000E+0 -4,3786E+1
2,0000E+0 -2,3267E+1
4,0000E+0 -1,5706E+1
6,0000E+0 -2,0040E+1
8,0000E+0 -2,8482E+1
1,0000E+1 -1,1263E+1
En la columna "A" del excel me pone los valor de la primera columna y en la "B" el de la segunda. Hasta aquí, todo perfecto. El problema es que el archivo txt es muy largo, es decir, tiene un montón de filas. Entonces cuando lo abro con el excel cuando llega al número máximo de filas del excel ya no pone más valores.
Mi idea es que cuando llegue al tope de filas del excel se pase a la columna "C" y que siga poniendo los valores (unos en la columna C y otros en la D) hasta que termine de pasar todos los valores del txt.
Y si vuelve a llegar al máximo de filas, que se pase a la columna E y así sucesivamente.
¿Cómo podría hacer esto?
Muchas gracias
Saludos
1 respuesta
Respuesta de caranbis
1
'ESM
Sub Importando()
'Para que esta macro funcione, debes añadir la librería scrrun.dll (c:\windows\system32\)
'Menú -Herramientas- (en el editor ed visual),
'-Referencias-, -Examinar-, y buscas el archivo que mencioné.
'
Dim Fso As New FileSystemObject, ts As TextStream
Dim strArchivo As String, strLinea As String
Dim Numero1 As Integer
Dim Numero2 As Integer
Dim Columna As Integer
Dim Fila As Double
Dim Tempo As String
Dim LimiteFila As Double
'
'Limitando a sólo TXT
strArchivo = Application.GetOpenFilename(FileFilter:="Archivos de texto (*.txt), *.txt")
If UCase(Mid(strArchivo, 1, 3)) = "FAL" Then Exit Sub
'
'Controlando datos ingresados:
Denuevo:
Err.Clear
Tempo = InputBox("Digite el número máximo de filas por columnas.")
If Not Tempo <> "" Then Exit Sub
On Error Resume Next
LimiteFila = Tempo
If Err = 13 Then GoTo Denuevo 'Si no es numérico pide el dato de nuevo.
'
Columna = 1
'
Set ts = Fso.OpenTextFile(strArchivo, ForReading, False)
Do Until ts.AtEndOfStream
Fila = Fila + 1
strLinea = ts.ReadLine
'OJO, ESTOY USANDO EL ESPACIO, COMO SEPARADOR DE COLUMNAS, COMO EN TU MACRO.
Numero1 = Trim(Mid(strLinea, 1, InStr(1, strLinea, " ", vbTextCompare)))
Numero2 = Trim(Mid(strLinea, InStr(1, strLinea, " ", vbTextCompare), Len(strLinea)))
Cells(Fila, Columna) = Numero1
Cells(Fila, Columna + 1) = Numero2
'
If Fila = LimiteFila Then
Fila = 0
Columna = Columna + 2
End If
'
Loop
'
End Sub
Sub Importando()
'Para que esta macro funcione, debes añadir la librería scrrun.dll (c:\windows\system32\)
'Menú -Herramientas- (en el editor ed visual),
'-Referencias-, -Examinar-, y buscas el archivo que mencioné.
'
Dim Fso As New FileSystemObject, ts As TextStream
Dim strArchivo As String, strLinea As String
Dim Numero1 As Integer
Dim Numero2 As Integer
Dim Columna As Integer
Dim Fila As Double
Dim Tempo As String
Dim LimiteFila As Double
'
'Limitando a sólo TXT
strArchivo = Application.GetOpenFilename(FileFilter:="Archivos de texto (*.txt), *.txt")
If UCase(Mid(strArchivo, 1, 3)) = "FAL" Then Exit Sub
'
'Controlando datos ingresados:
Denuevo:
Err.Clear
Tempo = InputBox("Digite el número máximo de filas por columnas.")
If Not Tempo <> "" Then Exit Sub
On Error Resume Next
LimiteFila = Tempo
If Err = 13 Then GoTo Denuevo 'Si no es numérico pide el dato de nuevo.
'
Columna = 1
'
Set ts = Fso.OpenTextFile(strArchivo, ForReading, False)
Do Until ts.AtEndOfStream
Fila = Fila + 1
strLinea = ts.ReadLine
'OJO, ESTOY USANDO EL ESPACIO, COMO SEPARADOR DE COLUMNAS, COMO EN TU MACRO.
Numero1 = Trim(Mid(strLinea, 1, InStr(1, strLinea, " ", vbTextCompare)))
Numero2 = Trim(Mid(strLinea, InStr(1, strLinea, " ", vbTextCompare), Len(strLinea)))
Cells(Fila, Columna) = Numero1
Cells(Fila, Columna + 1) = Numero2
'
If Fila = LimiteFila Then
Fila = 0
Columna = Columna + 2
End If
'
Loop
'
End Sub
'PULIENDO...
Sub Importando()
'Para que esta macro funcione, debes añadir la librería scrrun.dll (c:\windows\system32\)
'Menú -Herramientas- (en el editor ed visual),
'-Referencias-, -Examinar-, y buscas el archivo que mencioné.
'
Dim Fso As New FileSystemObject, ts As TextStream
Dim strArchivo As String, strLinea As String
Dim Numero1 As Integer
Dim Numero2 As Integer
Dim Columna As Integer
Dim Fila As Double
Dim Tempo As String
Dim LimiteFila As Double
'
'Limitando a sólo TXT
strArchivo = Application.GetOpenFilename(FileFilter:="Archivos de texto (*.txt), *.txt")
If UCase(Mid(strArchivo, 1, 3)) = "FAL" Then Exit Sub
'
'Controlando datos ingresados:
Denuevo:
Err.Clear
Tempo = InputBox("Digite el número máximo de filas por columnas.")
If Not Tempo <> "" Then Exit Sub
On Error Resume Next
LimiteFila = Tempo
If Err = 13 Then GoTo Denuevo 'Si no es numérico pide el dato de nuevo.
'
Columna = 1
'
Application.ScreenUpdating = False
Set ts = Fso.OpenTextFile(strArchivo, ForReading, False)
Do Until ts.AtEndOfStream
'La siguiente línea muestra La fila actual del archivo en la barra de estado de excel.
'(ezquina inferior izquierda):
Application.StatusBar = "Fila actual: " & ts.Line
'
Fila = Fila + 1
strLinea = ts.ReadLine
'OJO, ESTOY USANDO EL ESPACIO, COMO SEPARADOR DE COLUMNAS, COMO EN TU MACRO.
Numero1 = Trim(Mid(strLinea, 1, InStr(1, strLinea, " ", vbTextCompare)))
Numero2 = Trim(Mid(strLinea, InStr(1, strLinea, " ", vbTextCompare), Len(strLinea)))
Cells(Fila, Columna) = Numero1
Cells(Fila, Columna + 1) = Numero2
'
If Fila = LimiteFila Then
Fila = 0
Columna = Columna + 2
End If
'
Loop
'
End Sub
Sub Importando()
'Para que esta macro funcione, debes añadir la librería scrrun.dll (c:\windows\system32\)
'Menú -Herramientas- (en el editor ed visual),
'-Referencias-, -Examinar-, y buscas el archivo que mencioné.
'
Dim Fso As New FileSystemObject, ts As TextStream
Dim strArchivo As String, strLinea As String
Dim Numero1 As Integer
Dim Numero2 As Integer
Dim Columna As Integer
Dim Fila As Double
Dim Tempo As String
Dim LimiteFila As Double
'
'Limitando a sólo TXT
strArchivo = Application.GetOpenFilename(FileFilter:="Archivos de texto (*.txt), *.txt")
If UCase(Mid(strArchivo, 1, 3)) = "FAL" Then Exit Sub
'
'Controlando datos ingresados:
Denuevo:
Err.Clear
Tempo = InputBox("Digite el número máximo de filas por columnas.")
If Not Tempo <> "" Then Exit Sub
On Error Resume Next
LimiteFila = Tempo
If Err = 13 Then GoTo Denuevo 'Si no es numérico pide el dato de nuevo.
'
Columna = 1
'
Application.ScreenUpdating = False
Set ts = Fso.OpenTextFile(strArchivo, ForReading, False)
Do Until ts.AtEndOfStream
'La siguiente línea muestra La fila actual del archivo en la barra de estado de excel.
'(ezquina inferior izquierda):
Application.StatusBar = "Fila actual: " & ts.Line
'
Fila = Fila + 1
strLinea = ts.ReadLine
'OJO, ESTOY USANDO EL ESPACIO, COMO SEPARADOR DE COLUMNAS, COMO EN TU MACRO.
Numero1 = Trim(Mid(strLinea, 1, InStr(1, strLinea, " ", vbTextCompare)))
Numero2 = Trim(Mid(strLinea, InStr(1, strLinea, " ", vbTextCompare), Len(strLinea)))
Cells(Fila, Columna) = Numero1
Cells(Fila, Columna + 1) = Numero2
'
If Fila = LimiteFila Then
Fila = 0
Columna = Columna + 2
End If
'
Loop
'
End Sub
Buenas tardes,
Primero gracias por contestar. En la macro que os he mandado me he confundido: el asunto es que quiero separarlos por tabulador en vez de por espacio.
La otra cosa es que mi archivo txt las 2 columnas que os presento están separadas también por tabulador y cuando aplico la macro me salen todos los valores =0.
Saludos
Primero gracias por contestar. En la macro que os he mandado me he confundido: el asunto es que quiero separarlos por tabulador en vez de por espacio.
La otra cosa es que mi archivo txt las 2 columnas que os presento están separadas también por tabulador y cuando aplico la macro me salen todos los valores =0.
Saludos
' tabla ascii: http://www.ascii.cl/es/
'Reemplaza las líneas:
'OJO, ESTOY USANDO EL ESPACIO, COMO SEPARADOR DE COLUMNAS, COMO EN TU MACRO.
Numero1 = Trim(Mid(strLinea, 1, InStr(1, strLinea, Chr(9), vbTextCompare)))
Numero2 = Trim(Mid(strLinea, InStr(1, strLinea, Chr(9), vbTextCompare), Len(strLinea)))
'Reemplaza las líneas:
'OJO, ESTOY USANDO EL ESPACIO, COMO SEPARADOR DE COLUMNAS, COMO EN TU MACRO.
Numero1 = Trim(Mid(strLinea, 1, InStr(1, strLinea, Chr(9), vbTextCompare)))
Numero2 = Trim(Mid(strLinea, InStr(1, strLinea, Chr(9), vbTextCompare), Len(strLinea)))
