1

se trata de hacer un macro que revise (no quiero decir recorrer por que yo entiendo recorrer como mover un renglon abajo) los renglones de una columna, y si encuentra un valor ejemplo 10.80.50.20, que esa celda se pinte de un color. Pensaba en hacerlo con case pero soy bastante nuevo en la programación. Dejaré una ejemplificación de lo que tengo en mente.

introducir la descripción de la imagen aquí

Gracias por su atención y ayuda.

1
  • ¿Y qué has intentado hasta ahora? Estaría bien que pusieras tu código y que digas dónde te falla.
    – Esei
    Commented el 7 mar. 2019 a las 0:54

2 respuestas 2

2

Si lo puedes hacer con la función case y el ciclo for each.

Simplemente se selecciona el rango de datos y la función recorre cada celda comprobando su valor, en esa parte entra la función case para comprobar el valor de la celda en turno, dependiendo del valor, se le asigna un color de relleno.

Seria algo así:

Sub testColor()
    Dim rn, cell As Range

    Set rn = Selection

    For Each cell In rn
        Select Case cell.Value
            Case "10.8.20.10"
                cell.Interior.Color = rgbGreenYellow
            Case "10.8.20.11"
                cell.Interior.Color = rgbOrange
            Case "10.8.20.13"
                cell.Interior.Color = rgbYellow
        End Select
    Next cell

End Sub
2
  • 1
    Tu respuesta está bien, pero debería ser un Select Case True y en los Case poner Like "*.10" ya que el OP pone en su ejemplo terminaciones, tu respuesta sólo acepta esas 3 variables, pero si hubiera otros terminados en esos números, no funcionaría.
    – Damian
    Commented el 14 mar. 2019 a las 15:53
  • Gracias, este procedimiento realmente me funcionó. Saludos.
    – Human
    Commented el 14 mar. 2019 a las 18:28
1

Ok, agrega un modulo despues este codigo:

Sub ColorIPsDuplicadas()

    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("selecciona el rango:", "excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
      On Error Resume Next
      xCol.Add xCell, xCell.Text
      If Err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xCell.Text)
        If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
        xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
      ElseIf Err.Number = 9 Then
        MsgBox "demasiados duplicados!", vbCritical, " Excel macro"
        Exit Sub
      End If
      On Error GoTo 0
    Next
End Sub

y f5

1
  • Gracias, muy elaborado la funcionalidad.
    – Human
    Commented el 14 mar. 2019 a las 17:51

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.