Marcar celdas si coinciden con valor de columnas

Como puedo marcar en los cuadros de color los números que coincidan con el rango "dw2:dz2"

1 respuesta

Respuesta
1

Buenos días jhon murcia prueba si con un for each hace lo que tu necesitas


Sub ComparPintaR()
Dim XcX, XcelX As Range
For Each XcX In Range("DW2:DZ2")
    If Not XcX Is Nothing Then
        For Each XcelX In Range("EK2:EZ2")
            If XcX = XcelX Then
                XcelX.Interior.Color = vbYellow
            End If
        Next XcelX
    End If
Next XcX
End Sub

Revisa los rangos si son los que necesitas, de lo contrario cambialos por el que vayas a comparar

**

Maestro sebastián no sucede nada y además me gustaría que no se ejecutara como modulo sino automáticamente el código iría en la hoja 1

Por eso te aclare que revises los rangos sin son los que corresponden, aqui lo aplique sobre "EK2:EZ20" y mira el resultado

Si es esto lo que necesitas te funciona solo agregale un 0 a la macro porque yo le puse "EK2:EZ2" de lo contrario cambia ese rango por el que vas a comparar

En cuanto a el mudulo de la hoja si pones un for each automatico lo unico que lograras sera trancar el documento porque se ejecutara cada ves que cambies de celda

A menos que se ejecute solo cuando estes sobre DW2 o DX2 o DYZ o DZ2 seria algo asi

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim XcX, XcelX As Range
    If ActiveCell = Range("DW2") Or ActiveCell = Range("DX2") Or ActiveCell = Range( _
    "DY2") Or ActiveCell = Range("DZ2") Then
        For Each XcX In Range("DW2:DZ2")
            If Not XcX Is Nothing Then
                For Each XcelX In Range("EK2:EZ20")
                    If XcX = XcelX Then
                        XcelX.Interior.Color = vbYellow
                    End If
                Next XcelX
            End If
        Next XcX
    Else
    Exit Sub
    End If
End Sub

Recuerda verificar el rango a comparar

Le envío trabajo a su correo maestro

Te reenvíe el archivo revisa si era eso lo que querías hacer

[Si te a sido útil la información no olvides valorar la respuesta y cerrar la pregunta - Saludos]

¿A qué le dices que no se marca? ¿Qué esperas que la planilla te hable? XD ja ja yo veo que si funciona

¿Nos estamos refiriendo a comparación sobre el mismo rango?

Maestro el código funciona pero la idea es que no se ejecute como modulo sino que el código quede en la hoja1 y otra cosa que se olvido decirle es que cada numero debe ser pintado de acuerdo a su orden me explico si el 9 esta en dw2 entonces se colorea si esta en la primera columna de cada cuadro con color diferente es decir en ek, es, eo, ew

Como hacerlo en la hoja ya te pase una macro más arriba en cuanto a un color cada 4 celdas no sabría como hacer ya que obtener hacer un for each sobre el primer rango y cuatro por each más, uno sobre cada color y me pinta sólo 3 uno me lo omite... quizaa puedas hacerlo sobre el rango con un Vlookup pero yo nose como hacerlo

Maestro y de pronto este código fuera la solución y lo acomodaras al libro

Échele un ojito por favor

Sub Buscar_Numeros()

'Por.Dante Amor

    Application.ScreenUpdating = False

    Set h1 = Sheets("Cundi1")

    Set h3 = Sheets("formato")

    '

    uc = h1.Cells(2, Columns.Count).End(xlToLeft).Column

    For j = Columns("F").Column To uc Step 5

       h3.Range("B2:E7").Copy

        h1.Cells(2, j).PasteSpecial Paste:=xlPasteFormats

   Next

    '

    cod = Format(h1.[A2], "0000")

    'For i = 1 To 4    'se colocaron fórmulas

        'h1.Cells(3, i) = Mid(cod, i, 1)

    'Next

    '

    ns = Array(h1.[A3], h1.[B3], h1.[C3], h1.[D3])

    Dim celdas As New Collection

    For j = Columns("F").Column To uc Step 5

        Set celdas = Nothing

        M = 0

        For K = LBound(ns) To UBound(ns)

            Set b = h1.Range(h1.Cells(2, j + K), h1.Cells(7, j + K)). _

                Find(ns(K), lookat:=xlWhole)

            If Not b Is Nothing Then

                M = M + 1

                celdas.Add b.Row & "," & j + K

            Else

                Exit For

            End If

        Next

        If M = 4 Then

            For p = 1 To celdas.Count

                dire = Split(celdas(p), ",")

                fila = Val(dire(0))

                col = Val(dire(1))

                h1.Cells(fila, col).Interior.ColorIndex = 3

            Next

        End If

    Next

    Range("A2").Select

    Application.CutCopyMode = False

    Application.ScreenUpdating = True

End Sub

Proba esta macro que hice recién

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim D1x, D2x, D3x, D4x As Object
Dim xrng As String
Dim x1, x2 As String
Dim x3, x4 As String
Set RG = ActiveCell
If RG = Range("E2") Or RG = Range("F2") Or RG = Range("G2") Or RG = Range("H2") Then
    For Each rng In Range("ORIGEN")
        xrng = rng.Value
        For Each D1x In Range("DATA1")
            x1 = D1x.Value
            If xrng = x1 Then
                D1x.Interior.ColorIndex = 3
            End If
        Next D1x
        For Each D2x In Range("DATA2")
            x2 = D2x.Value
            If xrng = x2 Then
                D2x.Interior.ColorIndex = 4
            End If
        Next D2x
        For Each D3x In Range("DATA3")
            x3 = D3x.Value
            If xrng = x3 Then
                D3x.Interior.ColorIndex = 6
            End If
        Next D3x
        For Each D4x In Range("DATA4")
            x4 = D4x.Value
            If xrng = x4 Then
                D4x.Interior.ColorIndex = 8
            End If
        Next D4x
    Next rng
Else
Exit Sub

Te mando imagen del ejemplo para que arregles los rangos y nombres de los registros para que te funcione

Al hacer click sobre el rango "ORIGEN" se ejecuta la macro que se compra ese rango con "DATA1", "DATA2", "DATA3", "DATA4" y si encuentra el dato lo pinta... si esto era lo que necesitabas espero una excelente valoración jeje saludos.

Recuerda arreglar todos los registros y rangos para que te funcione correctamente

Los únicos rangos que tienes que cambiar en la macro son los que hace referencia la macro para ejecutarse, los demás solo dale los nombres que yo le di y ya funcionara

Ejemplo selecciona el rango "DW2:DZ2" y dale el nombre "ORIGEN", luego al rango "EK2:EN6" dale el nombre "DATA1" y así con los otros 3 rangos...

  • DW2:DZ2" = ORIGEN
  • "EK2:EN6" = DATA1
  • "EO2:ER6" = DATA2
  • "ES2:EV6" = DATA3
  • "EW2:EZ6" = DATA4

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas