Obtener datos de archivos .txt e importarlos a Excel.
Esta un poco complejo, espero me puedan apoyar, pero tengo un archivo en .txt del cual necesito extraer información y pasarla a una tabla de Excel. Normalmente en las primeras 30 filas del archivo de texto el contenido no cambia, podrá variar la información pero siempre es la misma cantidad de filas.
A partir de la fila 31, es donde si cambia la cantidad de información y cantidad de filas, dependiendo del archivo; aquí tengo que buscar la información y colocarla en la celda que le corresponde de mi tabla de Excel. Los encabezados de la tabla se encuentran desde B1 hasta K1 y los valores a buscar se encuentran de A2 hasta A6. Tanto encabezados en la fila 1, como los valores a buscar de la columna A, tienen el mismo nombre que la información del archivo txt.
Por ejemplo: En la columna B, el encabezado en B1 se llama "End1 Main1" y en la columna A, de la fila 2 a la 6, vamos a buscar: Diameter, intersectionAngle, CenterlineOffset, AxialAngle, WorkpontOffset. Dentro del código del archivo de txt podemos observar que:
34 [End1 Main1] ;id=f4e34a7a-5f15-4ad3-ad72-baf2e21c6fe3 **(la fila 34 contiene End1 Main1, este seria nuestro encabezado)**
35; Saddle Cut
36; Tekla XML macro: saddle
37Diameter=600.0 **(La fila 37 contiene el diameter que es igual a 600.0 / esta info iria en B2)**
38IntersectionAngle=53.130 **(La fila 38 contiene el IntersectionAngle que es igual a 53.130 / esta info iria en la celda B3, que le corresponde a IntersectionAngle)**
39CenterlineOffset=0.0
40WorkpointOffset=0.000
41AxialAngle=-90.000 **(La informacion de AxialAngle, en ocasiones viene con valor negativo, se pegaria tal cual, con el signo de resta)**
42Through=Y
43WeldPrepAngle=37.500
44; Vector POR, Y, Z data
45; Start: 24000, 21248.9821, 0
46; End: 24000, 22101.0179, 0
Y así sucesivamente con los demás valores, la macro tendría que buscar la coincidencia de palabras y colocar la información que venga después del signo de " = " en su celda correspondiente. Aunado a esto, en la fila 21 del archivo txt, vamos a encontrar el valor: "Length = ", este valor de length siempre sera colocado en la celda de intersección de "End2 Main1" con "WorkpointOffset".
Como lo mencione arriba, la información puede variar, en ocasiones solo puede venir en un archivo de txt, información de End1 Main1 y Eng1 Main2, la macro colocaría la información donde corresponde y para los demás End1 Main3, Main4 y Main5, dejaría todos los valores en 0.00.
En las imágenes adjuntas, coloque en código del archivo txt, para diferenciar con colores la ubicación de cada valor, dentro de la tabla. En caso de ser necesario, puedo enviar los archivos por correo, sin problema.
1 Respuesta
Podrías subir a google drive tu archivo de excel y dos archivos txt.
El archivo de excel, en la hoja1 deben estar llenas las celdas con la información del archivo txt1. La hoja2 con la información del archivo txt2.
Después de que subas los archivos a google drive, los compartes para que cualquiera que tenga el vínculo. Copias el vínculo y lo pegas aquí.
https://drive.google.com/drive/folders/1oc3Ho7NW9ksYrmBlpkPuJn7FEyZDJxNV?usp=sharing
Dante,
Envio adjunto la liga de los archivos .txt y el Excel con el codigo en la segunda pestaña.
La idea es, desde el Excel, poder seleccionar el archvio txt y que importe la informacion en la tabla.
Te agradezco.
Prueba la siguiente macro:
Sub Obtener_Datos()
'Por Dante Amor
Dim wb2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim c As Range, f As Range
Dim j As Long, k As Long
Dim archivo As String
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set sh1 = Sheets("Sheet1")
sh1.Range("B2:K6").ClearContents
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo txt"
.AllowMultiSelect = False
If Not .Show Then Exit Sub
archivo = .SelectedItems.Item(1)
End With
'
Workbooks.OpenText archivo, xlMSDOS, 1, xlFixedWidth
Set wb2 = ActiveWorkbook
Set sh2 = wb2.Sheets(1)
'
For j = 2 To Columns("K").Column
Set f = sh2.Range("A:A").Find(sh1.Cells(1, j), , xlValues, xlPart, , , False)
If Not f Is Nothing Then
'
For Each c In sh1.Range("A2", sh1.Range("A" & Rows.Count).End(3))
For k = f.Row + 1 To sh2.Range("A" & Rows.Count).End(3).Row
If Left(sh2.Range("A" & k).Value, 1) = "[" Then Exit For
If Left(sh2.Range("A" & k).Value, Len(c.Value)) = c.Value Then
sh1.Cells(c.Row, j).Value = Mid(sh2.Range("A" & k).Value, Len(c.Value) + 2)
Exit For
End If
Next
Next c
'
End If
Next j
'
Set f = sh2.Range("A:A").Find("Length", , xlValues, xlPart, , , False)
If Not f Is Nothing Then
sh1.Range("G6").Value = Mid(f.Value, 8)
End If
'
wb2.Close False
End Sub
