miércoles, 20 de julio de 2011

VBA: Evaluar datos coincidentes en una tabla de datos.

Recientemente llegó a mi correo una cuestión que me pareció interesante; me preguntaban por formas de reiterar procesos en macros. Emplearemos las más habitual para realizar bucles, la instrucción FOR ... NEXT:

...Con esto comparo la primera fila de datos (que he seleccionado para que sea Selection),
con la siguiente, que está en la segunda fila. El resultado de los valores coincidentes me lo coloca unas cuantas filas más abajo.
Sub Iguales()
Dim CompareRange As Variant, x As Variant, y As Variant
Set CompareRange = Worksheets("Hoja2").Range("A2:E2")
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(4, 0) = x
Next
Next
End Sub
¿Cómo puedo repetir este proceso para comparar la misma selección con la tercera fila, cuarta fila... n fila? Además los valores coincidentes también deberían ir colocándose en filas distintas, unos debajos de otros...
Esto de reiterar los procesos lo encuentro especialmente complicado, ya que me cuesta parametrizar las cosas para repetirlas n veces, y sobretodo, dónde colocar los resultados para que no se machaquen unos encima de otros... ...


Vemos que en el código propuesto por nuestra lectora emplea otra instrucción importante en nuestros códigos: FOR EACH ... IN ... NEXT. Lo que hace falta al desarrollo propuesto es que siga analizando las diferentes filas de la tabla, y añadiendo las coincidencias en distintas filas, para no 'machacar' las anteriores.
Supongamos nuestra tabla de datos inicial a comparar:

VBA: Evaluar datos coincidentes en una tabla de datos.


Nuestra fila a comparar, esto es, nuestra selección será la primera (A1:E1).
Debemos incluir nuestro código VBA en un módulo del Explorador de proyectos dentro del Editor de VBA (Alt+F11):

Sub EvaluaCoincidencias()

'www.excelforo.blogspot.com

Dim CompareRange As Variant, x As Variant, y As Variant
'con FOR analizaremos de las filas 2 a 4.
For i = 2 To 4
'definimos una variable que utilizaremos como rango
rng = "A" & i & ":E" & i
Set CompareRange = Worksheets("Hoja1").Range(rng)

'con FOR EACH repasamos cada celda de los rangos seleccionados y definidos como variable.
For Each x In Selection
For Each y In CompareRange

'evaluamos la coincidencia y nos la llevamos 4 filas por debajo.
If x = y Then x.Offset(4 + i, 0) = x

Next
Next
Next i

End Sub


Para ejecutar esta macro seleccionamos el rango a evaluar A1:E1 y desde la lista de macros ejecutamos EvaluaCoincidencias, o bien asignamos la macro a un botón, obteniendo el siguiente resultado:


VBA: Evaluar datos coincidentes en una tabla de datos.


Vemos como los elementos coincidentes para cada rango A2:E2, A3:E3 y A4:E4 con los valores de A1:E1 se llevan algunas filas más abajo, sin 'machacarse' (como decía nuestra lectora), manteniendo en este caso el orden de columnas de la selección A1:E1.

3 comentarios:

  1. Hola, buen dìa, estoy leyendo esta macro y es muy interesante para un trabajo que estoy haciendo ahora, el tema es que necesito que realize algunas tareas mas y seria ideal para mi trabajo:
    1)Que la macro luego de evaluar las lineas de abajo automaticamente comienze el mismo proceso con la proxima:
    En el ejemplo de Ud: A1:E1 HASTA A4:E4 y luego A2:E2 hasta A4:E4 y asi hasta la ultima, pero con rangos de inicio y finalizacion puesto por el usuario en la macro, ya que yo manejo una base de A10000:E10000, se imagina posicionandome manualmente en cada una.

    2) Qe copie los resultados igual que lo hace esta macro pero en vez de 4 filas abajo en la hoja 2 (si se puede, sino se parametriza mas filas hacia abajo, eso es indistinto)

    Bueno realmente muy buena la macro, seria muy importane para mi porque es mi trabajo y lo necesito.

    Muchas Gracias

    ResponderEliminar
    Respuestas
    1. Hola Diego,
      creo que deberías leer las Normas de uso del blog
      ;-)

      Saludos

      Eliminar
  2. Disculpa,solo queria saber si podes ayudarme a enriquecer tu macro que ya me es de utilidad, no se que tengo que hacer decime y no hay problema, lo hago.

    ResponderEliminar