Macro que copie celda si las dos anteriores son iguales pero en columnas diferentes

Este es el resultado de la macro

y esta es la macro

Sub comparaciones()
Set datos = Range("j2").CurrentRegion
Set datos2 = Range("o2").CurrentRegion
With datos
x = 1
    For i = 1 To .Rows.Count
        dato = .Cells(i, 1): dato2 = .Cells(i, 2)
        cuenta = WorksheetFunction.CountIfs(datos2.Columns(1), dato, datos2.Columns(2), dato2)
        If cuenta > 0 Then Range("r2").Cells(x, 1) = .Cells(i, 4): x = x + 1
    Next i
End With
Range("r:r").NumberFormat = "0000"
Set datos = Nothing: Set datos2 = Nothing
End Sub

He probado la macro y he obtenido resultados diferentes. En la imagen d tu respuesta, el resultado, es el correcto. Pero al ampliar las celdas no lo hace bien.

 En la columna S te indico el resultado que se debería obtener al ejecutar la macro.

También he probado incluyendo encabezados y al ejecutar la macro, he obtenido este resultado.

Observa la columna R.

Lo más curioso, ha sido al aplicarla en la hoja real, donde rellena la columna R con los datos de la columna D. Te adjunto imagen.

El problema esta en que no pusiste la pantalla real desde el principio y programe suponiendo que no tenias más columnas con datos que las mencionaste, por eso te da el resultado que te da, mira esta imagen es una estructura similar a la tuya, compara las columnas j y que con p y que de encontrar coincidencias colocara el valor de la columna M en la columna R

y esta es la macro

Sub COMPARAR_COLUMNAS()
FILAS = Range("A1").CurrentRegion.Rows.Count - 1
Set LISTA1 = Range("J2").Resize(FILAS, 2)
Set LISTA2 = Range("M2").Resize(FILAS, 1)
Set LISTA3 = Range("O2").Resize(FILAS, 2)
Set LISTA4 = Range("R2").Resize(FILAS, 1)
With LISTA3
    For I = 1 To FILAS
        AP_ORIGEN = LISTA1.Cells(I, 1)
        B_ORIGEN = LISTA1.Cells(I, 2)
        CUENTA = WorksheetFunction.CountIfs(LISTA3.Columns(1), AP_ORIGEN, _
        LISTA3.Columns(2), B_ORIGEN)
        If CUENTA > 0 Then LISTA4.Cells(I, 1) = LISTA2.Cells(I, 1)
    Next I
End With
Set LISTA1 = Nothing: Set LISTA2 = Nothing
Set LISTA3 = Nothing: Set LISTA4 = Nothing
End Sub

La macro, debe comparar los valores de las columnas J y K con los de las columnas O y P.
Cuando coincidan ambos valores J-K=O-P entonces copiar la celda correspondiente de la columna M y pagarla la celda correspondiente de la columna R.

En la imagen, J6+K6 coinciden con O13+P13 y la macro debería copiar M6 y pegarla en R13.

Esto con todos los valores de las columnas J y K comparándolas con todos los valores de las columnas O y P.

Espero que con este ejemplo se entienda mejor.

Este es el resultado de la macro

y esta es la macro

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 Sub

Solo se ocupa crear una hoja llamada hoja2 ya que compara columnas concatenadas

Funciona de maravilla y es rapidísima.

¿Me puedes enviar un código que mediante un botón elimine el fondo verde de las celdas después de ejecutar la macro?

Me has ayudado mucho. Te estoy muy agradecido.

Los colores se ponen mediante estas líneas solo bórralas

 lista1.Rows(indice2).Interior.ColorIndex = 4
            Lista2. Rows(indice). Interior. ColorIndex = 4

o si los quieres borrar con un boton esta es la macro

Sub borrar_colores()
With Range("a1").CurrentRegion
    filas = .Rows.Count
    col = .Columns.Count
    Range("a2").Resize(filas, col).Interior.ColorIndex = xlNone
End With
End Sub

Funciona perfectamente el último código que me has enviado para eliminar el color de las celdas, pero cuando ejecuto tu macro que colorea las celdas, se me ha ocurrido plantearte una nueva propuesta que prácticamente, me resolvería la totalidad de la hoja.

No se si será abusar de tu saber o tendría que formular una nueva pregunta en el foro (es la primera vez que he pedido ayuda en todoexpertos).

Te la planteo y ya me dices.

El complemento a esta macro, sería que después de lo que ya hace, 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 en la columna M y lo pegue en la celda correspondiente de la columna R.

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 los que tu macro ha coloreado de verde.

No se si he sido capaz de explicarme. Podría mandarte la hoja, pero no sé si es posible.

Gracias por tu atención y ayuda.

No le entendí nada a tu lista, pero de acuerdo a lo que escribes con esto es más que suficiente.

Sub lista()
a = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To a
If Cells(x, 10) = Cells(x, 15) And Cells(x, 11) = Cells(x, 16) Then
Cells(x, 18) = Cells(x, 13)
End If
Next x
End Sub

No debes tener valores vacíos en tu lista en la columna a o solo lo recorrerá hasta ahí.

La macro, debe comparar los valores de las columnas J y K con los de las columnas O y P.
Cuando coincidan ambos valores J-K=O-P entonces copiar la celda correspondiente de la columna M y pagarla la celda correspondiente de la columna R.

En la imagen, J6+K6 coinciden con O13+P13 y la macro debería copiar M6 y pegarla en R13.

Esto con todos los valores de las columnas J y K comparándolas con todos los valores de las columnas O y P.

Espero que con este ejemplo se entienda mejor.

¿Ya la probaste? Según yo con esa macro queda.

La he probado Daniel, pero no causa ningún efecto. ¿Me puedes indicar si debo seguir alguna acción especial?

He probado la otra que me han enviado y se ejecuta. También, tengo varias en el mismo libro y funcionan. Pero la tuya, no puedo ejecutarla (y me gustaría ver como funciona).

Bueno eso lo cambia todo, pensé que se evaluaba por filas pero veo en tu ejemplo que esa combinación puede estar en cualquier fila, Intenta así:

Sub lista()
a = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To a
b = Cells(x, "O").Value & Cells(x, "P").Value
For y = 2 To a
c = Cells(y, "J").Value & Cells(y, "K").Value
If b = c Then
Cells(x, "R") = Cells(y, "M")
End If
Next y
Next x
End Sub

¡FANTASTICO!

Ahora, se ejecuta perfectamente y los datos que he comprobado (manualmente), son correctos.

Mañana intentaré completar los que faltan y la ejecutaré nuevamente con el listado completo (más de mil filas que en algún caso, pueden llegar a cinco mil)

Muchas gracias por tu ayuda. Mañana te confirmo con toda la información disponible.

Solo califica la respuesta

Si vas a usar tantos datos es mejor que lo uses así:

Sub lista()
a = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To a
b = Cells(x, "O").Value & Cells(x, "P").Value
For y = 2 To a
c = Cells(y, "J").Value & Cells(y, "K").Value
If b = c Then
Cells(x, "R") = Cells(y, "M")
Exit For
End If
Next y
Next x
End Sub

Ahorrarás mucha mas memoria y tiempo

Hola Daniel,

Después de probar el último código enviado te indico los resultados obtenidos.

La macro, evidentemente, la he probado en la misma hoja (1032 filas y 32 columnas).

Con la macro anterior, ha tardado 15,38 segundos.

Con la última enviada, ha tardado 14,48 segundos.

Ambas funcionan perfectamente.

No se si será abusar de tu saber o tendría que formular una nueva pregunta en el foro (es la primera vez que he pedido ayuda en todoexpertos).

Te la planteo y ya me dices.

El complemento a esta macro, sería que después de lo que ya hace, 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 en la columna M y lo pegue en la celda correspondiente de la columna R excepto las ya comparadas J+K con O+P.

No se si he sido capaz de explicarme. Podría mandarte la hoja, pero no sé si es posible.

Gracias por tu atención y ayuda.