Complementar macro que compara celdas en varias columnas.
Tengo una macro que compara cada una de las celdas en las columnas J+K con cada una de las celdas de las columnas O+P. Cuando encuentra estas coincidencias (J+K=O+P), copia la celda correspondiente de la columna M la pega en la celda coincidente de la columna R y colorea las celdas coincidente de color verde.
Sub comparar_columnas()
Set datos = Sheets("hoja1").Range("a1").CurrentRegion
With datos
filas = .Rows.Count - 1
Set datos = .Rows(2).Resize(filas)
Set lista1 = .Cells(1, 10).Resize(filas, 2)
Set lista2 = .Cells(1, 15).Resize(filas, 2)
Set lista3 = .Cells(1, 13).Resize(filas, 1)
Set lista4 = .Cells(1, 18).Resize(filas, 1)
Set h2 = Worksheets("hoja2")
h2.Cells.Clear
Set datos2 = h2.Range("a1").Resize(filas, 2)
matriz = datos2
For i = 1 To filas
cadena = Application.Transpose(Application.Transpose(lista1.Rows(i)))
cadena2 = Application.Transpose(Application.Transpose(lista2.Rows(i)))
matriz(i, 1) = Join(cadena, ",")
matriz(i, 2) = Join(cadena2, ",")
Next i
h2.Range(datos2.Address) = matriz
For j = 1 To filas
cadena = datos2.Cells(j, 1)
On Error Resume Next
indice = WorksheetFunction.Match(cadena, datos2.Columns(2), 0)
If Err.Number = 0 Then
indice2 = WorksheetFunction.Match(cadena, datos2.Columns(1), 0)
lista1.Rows(indice2).Interior.ColorIndex = 4
lista2.Rows(indice).Interior.ColorIndex = 4
lista4.Cells(indice, 1) = lista3.Cells(indice2, 1)
End If
On Error GoTo 0
Next j
End With
Erase matriz
Set datos = Nothing: Set lista1 = Nothing: Set lista2 = Nothing
Set lista3 = Nothing: Set lista4 = Nothing: Set h2 = Nothing
End SubMe gustaría, completar esta macro añadiéndole código para que después de ejecutar lo expuesto anteriormente, comparase todas las celdas de la columna J solamente (no J+K) con las celdas de la columna O solamente (no O+P) y si son iguales, que copie el valor correspondiente de la celda en la columna M y lo pegue en la celda correspondiente de la columna R. Pero que no tenga en cuenta las celdas que ha comparado antes (las comparadas por el código que indico). Y las nuevas coincidencias, las coloree de amarillo (por ejemplo).
Intentaré resumirlo más.
Que después de lo que ya hace la macro, vuelva a comparar J y O y si son iguales, que pegue el valor de M en R excepto las celdas que el primer código ha coloreado de verde. Y las nuevas coincidencias, las coloree de amarillo (por ejemplo).
Esto, debe hacerlo con todas las filas de la hoja (entre 1000 y 5000).
1 Respuesta
Por lo que he podido entender
En fila por, se unen las columnas Jx y Kx,
Se unen las columnas Ox y Px,
Se compara el resultado. Copia Mx en Rx y pone la celda verde.
En la foto que has puesto no coincide ninguna columna
Hola
Es una captura de una región pequeña de la hoja (como indiqué en la pregunta las cantidad de filas son miles) las coincidencias, las compara con todas las filas de la hoja y muchas pueden estar por encima o por debajo de la captura.
Observa, por ejemplo en la fila 90 los valores de Jx+Kx. Ha comparado en toda la hoja y ha encontrado en la fila 89 que Ox+Px coinciden (puede haber muchas otras coincidencias que no aparecen en la captura). En este caso que te indico, ha copiado la celda correspondiente (fila 90 columna M) y lo ha pegado en la celda de la fila 89 columna R.
Lo que no está coloreado de verde en las columnas J+K, es porque esos valores, no existen en las columnas O+P.
Espero haberte clarificado un poco.
No entiendo muy bien la script que has puesto, pero te pongo un ejemplo de como sería.
Public Sub filas2()
'Indice para las celdas J y K
Dim indice_jk As Integer
'Indice para las celdas O y P
Dim indice_op As Integer
'Union de J y K
Dim jk As String
'Union de O y P
Dim op As String
'Fila de inicio donde empieza a la operacion para las columnas O y P
'Si las columnas tienen encabezados pon un 2
indice_jk = 1
'El While mira todos los valores de la columna J
'suponiendo que la columna O tiene el mismo número de datos
'Cuando encuentre un espacio en blanco
'que se supone que no hay más datos se para
While (Range("J" + CStr(indice_jk)) <> "")
'Fila de inicio donde empieza a la operacion para las columnas O y P
'Si las columnas tienen encabezados pon un 2
indice_op = 1
'Une los valores de las columnas J y K
jk = CStr(Range("J" + CStr(indice_jk))) + CStr(Range("K" + CStr(indice_jk)))
While (Range("O" + CStr(indice_op)) <> "")
'Une los valores de las columnas O y P
op = CStr(Range("O" + CStr(indice_op))) + CStr(Range("P" + CStr(indice_op)))
'Si el valor de la union de jk y op es igual
If (jk = op) Then
'Coloca el valor de la columna M en la columna R, en la misma fila
Range("R" + CStr(indice_op)) = Range("M" + CStr(indice_op))
'Color verde
Range("R" + CStr(indice_op)).Interior.ColorIndex = 4
Else
'Si no es igual mira que la columan j sea igual a la columna o
If (Range("J" + CStr(indice_jk)) = Range("O" + CStr(indice_op))) Then
'Coloca el valor de la columna M en la columna R, en la misma fila
Range("R" + CStr(indice_op)) = Range("M" + CStr(indice_op))
'Color amarillo
Range("R" + CStr(indice_op)).Interior.ColorIndex = 6
End If
End If
indice_op = indice_op + 1
Wend
indice_jk = indice_jk + 1
Wend
End Sub
