Saltar al contenido

Buscar en archivo de texto y devolver


Recommended Posts

publicado

Sé que con un archivo adjunto todo sería más fácil, pero en estos momentos no lo tengo conmigo....

Tengo un archivo de texto que contiene caracteres de ancho fijo y un rango de celdas en un libro de Excel que contiene valores

Mi deseo (que no consigo encontrar la forma de hacerlo) es crear una macro que busque en el archivo de texto todas las líneas que comienzan por la palabra "FORCE", compruebe si los caracteres de esa linea contenidos entre las posiciones 8 y 17 coinciden con el valor de alguna celda del rango en la hoja y, si coinciden, copie toda la línea del archivo de texto en un archivo nuevo .dat.

Si tenéis una respuesta rápida, lo agradeceré.

Saludos

publicado

Hola Sergio:

En principio se me ocurre una posible solución: Pasa el archivo de texto a una hoja de excel y luego filtra la primera columna con la palabra "FORCE" y posteriormente filtra la posicion 8 y 17 con los datos de las celdas pertinentes. Todo esto lo podrias hacer manualmente pero grabando todos los pasos con la grabadora de macros y despues se puede perfeccionar esa misma macro para eliminar las lineas inutiles o inoperantes.

Sin ejemplo es lo primero que se me ocurre, espero que te haya ayudado u orientado.

Andrés

publicado

pepafg, se trata de archivos te texto de hasta 20 gb con millones de líneas (no exagero). Lo que estaba buscando es un proceso que fuese relativamente rápido. Había pensado en introducir en una matriz los textos a comparar, es decir, las posiciones de la 8 a la 17 del archivo de texto, y los valores del rango de celdas de la hoja, pero no sé por qué, me aparecen errores.

publicado

Buenas, Sergio

He creado este pequeño código y parece que funciona.

Obviamente, se deberían configurar rutas, valores, etc....pero bueno, como idea....


Sub prueba_leer()
ruta = ThisWorkbook.Path & "\"
Archivo = Dir(ruta & "*.txt")
Set obj_FSO = CreateObject("Scripting.FileSystemObject")

'Creamos un archivo con el método CreateTextFile
Set nuevoarchivo = obj_FSO.CreateTextFile(ruta & "Resultado.dat", True)

Open [Archivo] For Input As #1
Do Until EOF(1)
Line Input #1, linea
If Left(linea, 5) = "FORCE" Then
If Mid(linea, 8, 10) = Range("a1").Value Then
nuevoarchivo.WriteLine linea
End If
End If
Loop
nuevoarchivo.Close
Close #1
End Sub
[/CODE]

Un saludo,

Tese

publicado

Algo así había pensado yo, pero no me serviría....

El rango en la hoja de cálculo está compuesto de 23 celdas más o menos. Si el archivo de texto, que tiene un millón de líneas, debe leerse 23 veces, imagina el tiempo que puede tardar en leer 23 millones de líneas....

Te agradezco la respuesta, pero necesitaría algo más rápido.

publicado

Pues quizás se pueda combinar con un bucle que chequee cada uno de esos valores de las 23 celdas, que previamente se hubieran incluido en un Array.

Un saludo,

Tese

publicado

Vamos a ver, Sergio, si con un par de modificaciones al primer código que he propuesto se consigue algo.


Sub prueba_leer()

For Each valor In Range("a1:a23")
cadena = valor & "," & cadena
Next valor

ruta = ThisWorkbook.Path & "\"
Archivo = Dir(ruta & "*.txt")
Set obj_FSO = CreateObject("Scripting.FileSystemObject")

'Creamos un archivo con el método CreateTextFile
Set nuevoarchivo = obj_FSO.CreateTextFile(ruta & "Resultado.dat", True)

Open ruta & Archivo For Input As #1
Do Until EOF(1)
Line Input #1, linea
If Left(linea, 5) = "FORCE" Then
If InStr(1, cadena, Mid(linea, 8, 10)) > 0 Then
nuevoarchivo.WriteLine linea
End If
End If
Loop
nuevoarchivo.Close
Close #1

End Sub[/CODE]

He creado una cadena con los valores y después utilizo InStr para que realice la comparacion de los caracteres 8 a 17 de la línea para ver si esta en dicha cadena.

Un saludo,

Tese

publicado

pepafg, el problema sería que no siempre van a ser 23 datos los que buscar.

tese, tu solución acelera mucho la macro, pero creo que se podría acelerar más.

gracias a los dos por vuestras propuestas.

publicado
pepafg, el problema sería que no siempre van a ser 23 datos los que buscar.

tese, tu solución acelera mucho la macro, pero creo que se podría acelerar más.

gracias a los dos por vuestras propuestas.

amigo Sergio, de verdad que sería de mucha ayuda por lo menos tener una muestra de los datos, la solución que propone el amigo tese1969 se ve muy buena, dificilmente creo que se pueda mejorar a menos que tengamos información sobre los datos a procesar para ver si se puede buscar otra solución, pero bueno, si no se puede subir una muestra ni modo, suerte

publicado

Bueno, Sergio y compañía.....al menos no vamos a peor....:friendly_wink:

Quizás y esto es algo que desconozco, se podría usar una especie de ".Find" y su correspondiente ".Findnext" a lo largo del archivo de texto para ir saltando aquellas líneas que no tengan "FORCE" y ese sería el ahorro.

Mejor realizar la comprobación del "Instr" sobre pongamos 150.000 líneas con "FORCE" que pasar por 1.000.000 de líneas.

Por si sirve como idea para seguir acelerando la ejecución.

Un saludo,

Tese

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29

    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Que tal nuevamente,  adjunto una solución alternativa: =MAX(A:.A)-BYROW(F4:.AK20,LAMBDA(r,BUSCAR(2,1/(r=0),F3:.AK3))) Cabe mencionar que esta solución requiere funciones nuevas como RECORTAR.RANGO. CONTADOR FINAL (Solucion).xlsb
    • Buenos días,  espero se encuentren bien de salud compañeros, Favor me podrían ayuda con lo siguientes como se podría hacer cuando tengo una tabla dinámica que  amedida que se aumente las columnas fechas con data un formula que se coloco al final busque o analice siempre la ultima fila y columna de la fecha. Coloco un ejemplo
    • @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • 'Opción 1 Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim diccionarioSKU As Object Dim listaEliminar As Object Dim fechaActual As String, fechaSiguiente As String Dim f As Variant With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Crear diccionarios para comparar SKU y almacenar filas a eliminar Set diccionarioSKU = CreateObject("Scripting.Dictionary") Set listaEliminar = CreateObject("Scripting.Dictionary") ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo ' Guardar los SKU de la fecha siguiente (solo de la siguiente) For f = fila + 1 To ultimaFila If .Cells(f, 1).Value <> fechaSiguiente Then Exit For diccionarioSKU(.Cells(f, 2).Value) = 1 Next f ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Solo eliminar si el SKU no está en la fecha siguiente If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then listaEliminar(f) = 1 ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar.keys .Rows(f).Delete Next End With MsgBox "Completado correctamente.", vbInformation End Sub 'Opción 2 Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim listaEliminar As Collection Dim fechaActual As String, fechaSiguiente As String Dim f As Variant, i As Long Dim SKUExiste As Boolean With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Inicializar la colección para marcar las filas a eliminar Set listaEliminar = New Collection ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Comprobar si el SKU está en la fecha siguiente SKUExiste = False For i = fila + 1 To ultimaFila If .Cells(i, 1).Value <> fechaSiguiente Then Exit For If .Cells(i, 2).Value = .Cells(f, 2).Value Then SKUExiste = True Exit For End If Next i ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar If Not SKUExiste Then listaEliminar.Add f ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar .Rows(f).Delete Next f End With MsgBox "Completado correctamente.", vbInformation End Sub   TABLA ELIMINAR.xlsm
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.