Importar datos de archivo *. A excel
Tengo un fichero con una serie de coordenadas de posición, de la forma:
# POINT 1 X 0018.782 Y 0053.181 Z -0071.222 # POINT 2 X 0021.685 Y 0052.569 Z -0071.220 # POINT 3 X 0025.732 Y 0050.690 Z -0071.220 # POINT 4 X 0029.505 Y 0047.279 Z -0071.221
Me gustaría generar una nueva hoja de excel con 4 columnas:
-- Número de punto
--Coordenada X
--Coordenada Y
--Coordenada Z
Me gustaría tener un botón que me de la opción de elegir un fichero *.txt y que automáticamente se genere la nueva hoja con los resultados. Si se vuelve a pulsar el botón (situado en la hoja inicial), si puede ser, me gustaría que los nuevos resultados sobrescriban a los anteriores.
H o l a: Te anexo la macro.
Cuando ejecutas la macro te pregunta si quieres una hoja nueva, si seleccionas Sí, te crea una hoja, si seleccionas no, te pone la información en la hoja activa, si seleccionas cancelar, termina la macro.
Después te abre una ventana para seleccionar el archivo.
Sub ImportarArchivo()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
'
res = MsgBox("Quieres una hoja nueva", vbYesNoCancel, "IMPORTAR ARCHIVO")
Select Case res
Case vbYes
l1.Sheets.Add after:=l1.Sheets(l1.Sheets.Count)
Case vbNo
'Set h1 = l1.ActiveSheet
Case vbCancel
Exit Sub
End Select
Set h1 = l1.ActiveSheet
h1.Cells.Clear
'
ruta = l1.Path & "\"
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo TXT"
.Filters.Clear
.Filters.Add "archivos txt", "*.txt"
.AllowMultiSelect = False
.InitialFileName = ruta
If Not .Show Then Exit Sub
archivo = .SelectedItems.Item(1)
End With
'
Workbooks.OpenText Filename:=archivo, _
Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
j = 1
For i = 1 To h2.Range("A" & Rows.Count).End(xlUp).Row Step 4
h1.Cells(j, 1) = h2.Cells(i, "A")
h1.Cells(j, 2) = h2.Cells(i + 1, "A")
h1.Cells(j, 3) = h2.Cells(i + 2, "A")
h1.Cells(j, 4) = h2.Cells(i + 3, "A")
j = j + 1
Next
l2.Close False
Application.ScreenUpdating = True
MsgBox "Archivo Importado", vbInformation
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
