Función comparar celdas y eliminar parte de una fila

Tengo que comparar dos celdas de una misma fila.

Si son iguales, no hay que hacer nada.

Sin son distintas, tengo que pasar los datos a otras celdas y eliminar y desplazar la celdas hacia arriba.

Function CALCULO(FING As Range)
    COLUMNA = ActiveCell.Column
    FILA = FING.Row
    If Cells(FILA, 6) = Cells(FILA, 1) Then
    Else
        Cells(FILA, 10) = Cells(FILA, 1)
        Cells(FILA, 11) = Cells(FILA, 2)
        Cells(FILA, 12) = Cells(FILA, 3)
        Cells(FILA, 13) = Cells(FILA, 4)
        'y después de copiar tengo que eliminar
 'cells(fila, 10)
        'cells(fila, 11)
        'cells(fila, 12)
        'cells(fila, 13)
        ' Y desplazar las celdas hacia arriba
    End If
End Function

1 respuesta

Respuesta
1

¿Por qué con una función?

Las funciones, aún las personales, devuelven un resultado, como SUMA, CONTAR.SI, BUSCARV...

Leyendo tus instrucciones noto que necesitas una macro que evalue el contenido de col A y F y según eso mover celdas de A:D a las col 10:13. Interpreto que luego se borran las celdas movidas, es decir las de las col A:D

Entonces coloca esta macro en un módulo del editor. Se ejecuta teniendo seleccionada alguna celda de la fila a controlar.

La podrás ejecutar desde un botón, desde la opción Macros o con un atajo de teclado... estos detalles los dejé explicados en la sección Macros de mi sitio.

Si necesitas realizar esta acción 'recorriendo' una cantidad de filas necesitarás algún bucle... en ese caso comentame más en detalle cómo harás el proceso.

Sub comparaCeldas()
'x Elsamatilde
'solo se debe seleccionar 1 celda de la fila a comparar
If Selection.Count > 1 Then Exit Sub
'controla col F y A de la fila seleccionada
FILA = ActiveCell.Row
If Cells(FILA, 6) <> Cells(FILA, 1) Then
'si son distintas se mueven los datos a otras columnas
    Cells(FILA, 10) = Cells(FILA, 1)
    Cells(FILA, 11) = Cells(FILA, 2)
    Cells(FILA, 12) = Cells(FILA, 3)
    Cells(FILA, 13) = Cells(FILA, 4)
    'y después de copiar tengo que eliminar
'se eliminan las celdas de col 1 a 4 desplazando hacia arriba
    Range("A" & FILA & ":D" & FILA).Select
    Selection.Delete Shift:=xlUp
    End If
End Sub

Probalo y comentame si esto resuelve tu consulta. En ese caso no olvides valorarla y finalizarla.

Buenos días.

Muchas gracias por contestar.

Estoy muy verde en esto de las macro y las funciones.

Como podrñia mandarte mi hoja de calculo para que vieras que necesito.

Gracias anticipadas

Pasando el mouse por el botón CORREO de mi sitio se observa en la barra de estado la dirección. Adjunto imagen.l

Enviame el libro con mi macro incluida y todas las explicaciones de lo que intentas obtener.

Sdos!

Buenos días.

Perdona que te moleste.

He añadido un blucle FOR y no consigo que funcione.

Sub comparaCeldas()
'x Elsamatilde
'solo se debe seleccionar 1 celda de la fila a comparar
'If Selection.Count > 1 Then Exit Sub
'controla col F y A de la fila seleccionada
For I = 1 To 57945
    FILA = I

'el valor de I aumenta de uno en uno pero FILA=ActiveCell.Row siempres está en 1

    FILA = ActiveCell.Row

    If Val(Cells(FILA, 6)) <> Val(Cells(FILA, 1)) Then
        'si son distintas se mueven los datos a otras columnas
        Cells(FILA, 10) = Cells(FILA, 1)
        Cells(FILA, 11) = Cells(FILA, 2)
        Cells(FILA, 12) = Cells(FILA, 3)
        Cells(FILA, 13) = Cells(FILA, 4)
        'y después de copiar tengo que eliminar
        'se eliminan las celdas de col 1 a 4 desplazando hacia arriba
        Range("A" & FILA & ":D" & FILA).Select
        Selection.Delete Shift:=xlUp
    End If
Next I
End Sub

En ese caso no hace falta la celda activa sino solamente la variable FILA:

Sub comparaCeldas()
'x Elsamatilde
'solo se debe seleccionar 1 celda de la fila a comparar
If Selection.Count > 1 Then Exit Sub
'controla col F y A de la fila seleccionada
'recorre desde fila 1 hasta 58000
For I = 1 To 58000
FILA = I
If Cells(FILA, 6) <> Cells(FILA, 1) Then
'si son distintas se mueven los datos a otras columnas
    Cells(FILA, 10) = Cells(FILA, 1)
    Cells(FILA, 11) = Cells(FILA, 2)
    Cells(FILA, 12) = Cells(FILA, 3)
    Cells(FILA, 13) = Cells(FILA, 4)
    'y después de copiar tengo que eliminar
'se eliminan las celdas de col 1 a 4 desplazando hacia arriba
    Range("A" & FILA & ":D" & FILA).Select
    Selection.Delete Shift:=xlUp
End If
Next I
End Sub

El bucle puede ir llegar hasta la última celda con datos de cierta columna, por ej: la col A

For I = 1 to Range("A" & rows.count).end(xlup).row

Así a medida que vas eliminando registros en A:D, se suben las celdas ... y no se ejecutará más allá de lo necesario.

Sdos!

¿Ya esta resuelto? En ese caso no olvides valorar y finalizar la consulta.

Sdos!

Según me comentas: '... El problema que me encuentro es que si un valor de la columna A no está en la columna E...'

Pero observa tus pasos:

- Si la celda E1 es igual a la celda A1 compara la celda G1 con la celda C1... y sigues comparando otras col

Más adelante sigues:

- Si la celda E1 es distinta a la celda A1 copia el valor de la celda A1 en la celda I1,... y sigue tu proceso.

Es decir que las 2 opciones están contempladas.

Viendo esos datos en amarillo, debieras 'ordenar' previamente los 2 rangos (el 1ro por col A y el 2do por col E ) y así la comparación sigue tu idea original.

Sdos y comenta el resultado.

Elsa

Muchísimas ¡Gracias!

Creo que por ahora me vale. Si tuviera que implementar algo más en la macro te mandaría un correo

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas