Excel - Encontrar y eliminar

Pos: 19

Val: 140

Encontrar y eliminar

Publicado por Luis (60 intervenciones) el 23/11/2020 14:10:37

Buenas a todos,
Importando unos DXF al EXCEL, no encuentro la forma de que al encontrar en cada columna la palabra "LINE" se borre el contenido de todas las celdas que hay por debajo, incluida esa misma.

He estado probando adaptaciones del siguiente código:

Row = "1"

texto = "LINE"

valor = texto

If IsNumeric(texto) Then valor = Val(texto)

For i = Range(Columns.Count & Row).End(xlLeft).Column To A Step -1

    If LCase(Cells("1", i)) = LCase(valor) Then

        Cells.Select

        Range(Selection, Selection.End(xlDown)).Select

        Selection.Delete

    End If

Next

Pero me da error en la quita línea y necesito que recorra cada columna que haya (es variable) haciendo eso.

Ya puesto, pretendo que solo queden las celdas que hay entre las celdas con "POINT" sin los siguientes valores que veréis que siempre son constantes:

8
0
10
20
30
0.0
0

Para que solo queden las coordenas X e Y que son los único valores con decimales. Pueden eliminarse también las de "POINT" porque se mantiene el orden 2 a 2.

Os adjunto un ejemplo con seis DFX importados.

GRACIAS!

Muestra.zip(716,8 KB)

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

Pos: 2

Val: 4.908

Encontrar y eliminar

Publicado por Antoni Masana (2481 intervenciones) el 23/11/2020 17:57:14

No entiendo que es lo que estas haciendo.
Importas varios ficheros DXF que no veo.
Veo o creo entender que copias a saco todo el contenido de todos los fichero origen en el destino y después quieres borrar.
Como no se que son ni como son los ficheros DXF ni que es lo que quieres o no quieres copiar ni la razón de ello voy a especular.

Lee línea a línea o registro a registro el fichero origen hasta que encuentres el texto LINE o el final de fichero, cierra el fichero y pasa al siguiente.

Es más simple.

Saludos.
\\//_

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

Pos: 19

Val: 140

Encontrar y eliminar

Publicado por Luis (60 intervenciones) el 23/11/2020 20:26:18

Jaja perdona Antoni. Siempre estás a tope!

A ver. Cada columna equivale al código de un DXF. Tengo que importar muchos pero para el ejemplo sólo he puesto 6. No tengo problemas cuando los importo. Tengo problemas una vez que ya está todo importado y las columnas con datos. Ahí es cuando debo quedarme únicamemte con las celdas con decimales que están entre aquellas con la palabra "POINT" en cada columna. Esas celdas son las coordenadas X e Y de los puntos que representa el DXF.

En todas las celdas, todo lo referido a los puntos está al principio hasta una celda (que varía en cada columna) que contiene el texto "LINE".

Por ello, necesito borrar en cada columna todo lo que venga después de la primera celda con "LINE", porque es info que no me interesa. El problema está es que la longitud de todas las columnas es variable y esa primera celda con el texto "LINE" también.

Espero que esté más claro ;)

Gracias!

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Encontrar y eliminar

Publicado por Luis (60 intervenciones) el 24/11/2020 10:28:25

He encontrado una manera más sencilla de hacerlo.

Necesito eliminar de cada columna con datos el contenidos de las últimas 2433 celdas de cada una.

Quizá así sea menos difícil.

Gracias!

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Encontrar y eliminar

Publicado por Antoni Masana (2481 intervenciones) el 24/11/2020 13:31:40

Buenas Luis,

Te voy a hacer una macro para cargar solo la parte que quieres de cada fichero DXF.

Solo una pregunta para continuar, La cabecera o sea la fila 1 ¿es el primer registro del DXF i es el nombre del fichero?

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Encontrar y eliminar

Publicado por Luis (60 intervenciones) el 24/11/2020 16:48:20

Muchas gracias!

Se trata del nombre del DXF.

Pero creo que voy a desistir...porque llego a un resultado donde ya no sé cómo continuar.

Es decir, llego hasta el punto de eliminar lo que no quiero y quedarme con lo necesario, que son las coordenadas X e Y (aquellas pares de celdas con un número con una coma y un cero). Pero no necesito todos los puntos, sólo quedarme con el punto cuya coordenadas X sea la más cercana al cero siempre y cuando su coordenada Y se encuentre en el intervalo (200,1000). Todo en valor absoluto.

Entonces cuando llego al punto de tener los 6 listados con todos los puntos y sus coordenadas, no encuentro la forma de cribar u ordenar para quedarme con el punto dicho arriba de entre las 6 columnas.

Es decir, encontrar en qué DXF se encuentra dicho punto y saber cuál es dicho punto (me interesa mucho más saber la coordenada X de este punto que su coordenada Y, por si hubiera que prescindir de las coordenadas Y pero siempre y cuando hayan cumplido la condición del intervalo antes dicha).

En fin, es una cosa que si sale genial pero si no, no pasa nada!

Si supone mucho engorro, por favor ni te molestes.

Yo he estado un rato pero al llegar al punto de los listados que te comento, no se cómo continuar.

Adjunto ese punto por si se ocurriera algo...

Gracias!

Muestra.zip(28,9 KB)

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Encontrar y eliminar

Publicado por Luis (60 intervenciones) el 24/11/2020 19:15:30

Por si no ha quedado claro, de entre las 6 columnas que te he enviado (ya están solo los puntos cuya coordenada Y se encuentra en el intervalo dicho), necesito que quede el punto cuya coordenada X en valor absoluto sea menor (más cercana al 0).
El menor de todas las columnas.

Seguro que es una bobada pero me está costando lo suyo.

Gracias!

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Encontrar y eliminar

Publicado por Antoni Masana (2481 intervenciones) el 24/11/2020 21:42:17

He realizado un par de macros.

La primera tarda 188 segundos.

Option Explicit

Sub ejemplo_2()

    Dim Archivo As String, Registro As String

    Dim Filas As Long, Colum As Integer

    Dim Ini As Single

    Ini = Timer

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    Application.DisplayStatusBar = True

    ChDir ActiveWorkbook.Path

    Archivo = Dir("*.dxf")

    Filas = 1

    Colum = 1

    Do While Archivo <> ""

        Application.StatusBar = "Archivo: " & Archivo

        Cells(Filas, Colum) = Archivo

        Filas = Filas + 1

        Open Archivo For Input As #1

        Registro = ""

        While Not EOF(1) And Registro <> "LINE"

            Line Input #1, Registro

            If Registro = "POINT" Then

                Application.StatusBar = "Archivo: " & Archivo & " - Fila: " & Filas

            End If

            If Registro <> "LINE" Then

               Cells(Filas, Colum) = Registro: DoEvents

               Filas = Filas + 1

            End If

        Wend

        Colum = Colum + 1

        Filas = 1

        Close #1

        Application.DisplayAlerts = False

        Archivo = Dir()

    Loop

    Application.DisplayStatusBar = False

    MsgBox "proceso terminado." & vbCrLf & vbCrLf & "Tiempo: " & Timer - Ini

End Sub

La segunda tarda 3 segundos .

Es la tuya con unos pequeños cambios

Sub ejemplo()

    Dim Mio As String, Ruta As String, Archivo As String, _

        Fila As Long, Ini As Single, Columna As Integer

    Ini = Timer

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    Mio = ActiveWorkbook.Name

    Ruta = ActiveWorkbook.Path

    ChDir Ruta & "\"

    Archivo = Dir("*.dxf")

    Columna = 1

    Do While Archivo <> ""

        Workbooks.OpenText Archivo, _

                           origin:=xlWindows, _

                           startrow:=1, _

                           DataType:=xlDelimited

        otro = ActiveWorkbook.Name

        Fila = 1

        While Cells(Fila+1, 1) <> "LINE" And Fila+1 <= 2^20

            Fila = Fila + 1

        Wend

        Range("a1:a" & Fila).Copy

        Workbooks(Mio).Activate

        Cells(1, Columna) = Archivo

        Cells(2, Columna).Select

        ActiveSheet.Paste

        Columna = Columna + 1

        Workbooks(otro).Close False

        Archivo = Dir()

    Loop

    MsgBox "proceso terminado." & vbCrLf & vbCrLf & "Tiempo: " & Timer - Ini

End Sub

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Encontrar y eliminar

Publicado por Luis (60 intervenciones) el 24/11/2020 21:50:48

Genial, no sabes cuánto lo agradezco.

Mañana cuando tenga acceso, lo veo. Aunque mi gran problema sigue siendo el de aislar el único punto cuya coordenada X se acerca más al cero y cuya coordenada Y pertenece al intervalo [200,1000] en valor absoluto.

Muchas gracias por tu dedicación ;)

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Encontrar y eliminar

Publicado por Luis (60 intervenciones) el 25/11/2020 11:41:34

Muchas gracias!

Ya lo he probado y la primera funciona perfectamente y me tarda unos 100 s, aunque depende del número de DXF a importar, claro. Funciona perfectamente.

En la segunda:

He definido la variable "Otro".

Me aparece error de sintaxis en la siguiente línea :

While Cells(Fila+1, 1) <> "LINE" And Fila+1 <= 2^20

Gracias de nuevo ;)

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Encontrar y eliminar

Publicado por Antoni Masana (2481 intervenciones) el 25/11/2020 14:35:04

Faltan alguno espacios para que Excel la reconozca.

sub Ejemplo()

...

        While Cells(Fila + 1, 1) <> "LINE" And _

              Cells(Fila + 1, 1) <> "" And Fila < 2 ^ 20

...

End Sub

Lo que hace el While es buscar hasta que encuentre la palabra LINE pero le añado que además siga mientras en la columna tenga datos, es decir se pare cuando encuentre un celda vacía o llegue al final de la hoja.
Con la primera condición funciona pero el resto es por si falla la primera no de error. ¿Estoy seguro de que siempre encontraré el texto? si es si las demás condiciones sobran, si puede fallar es mejor ponerlas, vale mas que copie de más a que de error y no están todas las posibles causas de error contempladas.

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Encontrar y eliminar

Publicado por Luis (60 intervenciones) el 26/11/2020 00:02:47

Te expresas genial y se entiende todo muy bien.

Gracias por tu labor docente ;)

Y sobre el último ejemplo, ¿hay manera de hacer lo que comento arriba? Aislar el dichoso y único punto de las 6 columnas con la coordenada X de menos valor siempre y cuando su coordenada Y esté en ese intervalo?

Gracias!

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Encontrar y eliminar

Publicado por Luis (60 intervenciones) el 26/11/2020 11:55:56

Buenas, Antoni.

He probado la macro y funciona perfectamente.

¿Podría importar los DXF que estuvieran en un directorio predefinido? Lo he intentado con el siguiente código pero nada:

......

Ini = Timer

Mio = ActiveWorkbook.Name

MiRuta = "G:\CarpetaOrigenDXF"

ChDir Ruta & "\"

MiArchivo = Dir("*.dxf")

Archivo = Dir(MiRuta & MiArchivo)

Columna = 1

Do While Archivo <> ""

    Workbooks.OpenText Archivo, _

                       origin:=xlWindows, _

                       startrow:=1, _

                       DataType:=xlDelimited

    otro = ActiveWorkbook.Name

    Fila = 1

    While Cells(Fila + 1, 1) <> "LINE" And _

    .......

Gracias!

Valora esta respuesta

Comentar

Copiar y pegar una validación datos de una libro a otro de Excel

LIBRO DESAPARECIDO