formatos condicionales minimo y maximo en un rango

Aporta tus trucos y consejos Excel de interés para la comunidad.
Reglas del Foro
Este foro no es para hacer preguntas!
Este foro solo es para que aportes algo de interés para la comunidad.
(para preguntas vuelve al índice y busca los foros de "Tus Preguntas a la Comunidad")
Responder
aitorsol
Miembro Nuevo
Miembro Nuevo
Mensajes: 2
Registrado: 23 Abr 2006 17:11

formatos condicionales minimo y maximo en un rango

Mensaje por aitorsol » 24 Oct 2018 11:30

Macro VBA para establecer el formato condicional para mínimo valor y máximo valor por fila en un rango dado por código o seleccionado por el usuario según el ejemplo que se adjunta.

Imagen

Código: Seleccionar todo

Option Explicit
Sub ConditionalFormatMinMaxValuesInARow(Optional r As Variant)
          ' ----------------------------------------------------------------
          ' Procedure : ConditionalFormatMinMaxValuesInARow
          ' Purpose   : Setup the conditional formating of the selected cells with the formulas to Max and Minimum values in a row
          ' Parameter : optional R (Variant) is the Range of the selected cells by code (type range or type string)
          '             the default value if it is missing or not is valid is the user selection
          ' usage     : ConditionalFormatMinMaxValuesInARow("$C3:$T15")
          ' Author    : Aitor Solozabal Merino - email:aitorsolozabal@gmail.com
          ' Date      : 19/09/2018
          ' ----------------------------------------------------------------

10        On Error GoTo ConditionalFormatMinMaxValuesInARow_Error
          Dim Rango As Range
          'check if an argument has been sent
20        If Not IsMissing(r) Then
              'there is an argument sent
              'check type of the argument
30            If TypeOf r Is Range Then
                  'It's a range
40                Set Rango = r
50            Else
                  'It's not a range
60                If TypeName(r) = "String" Then
                      'It's a string
70                    If Len(r) > 4 Then
                          'is not empty and has 5 characters as minimum (A1:B1)
                          'then choose string with the address specified as an argument
80                        Set Rango = Range(r)
90                    Else
                          'it is empty or not valid then choose user selection
100                       Set Rango = Range(Selection.Address)
110                   End If
120               Else
                      'the argument is diferent from a string and from a range and/or is not valid
                      'it is like empty and then choose user selection
130                   Set Rango = Range(Selection.Address)
140               End If
150           End If
160       Else
              'it is missing the argument then choose user selection
170           Set Rango = Range(Selection.Address)
180       End If
190       If IsValidAddress(Rango.Address) Then
200           Rango.Select
210           With Selection
                  'Delete any previous conditional formatting
220               .FormatConditions.Delete
                  '============================================ MAX VALUE
                  'add conditional formatting MAX to selected cells
230               .FormatConditions.Add Type:=xlExpression, Formula1:="=" _
                      & Selection.Cells(1).Address(False, False) _
                      & "=MAX(" & Rango.Rows(1).Address(False, True) & ")"
                  'Assigning red color for the conditional formatting MAX
240               .FormatConditions(1).Interior.ColorIndex = 3
250               .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
260               .FormatConditions(1).StopIfTrue = False
                  '============================================ MIN VALUE
                  'add conditional formatting MIN to selected cells
270               .FormatConditions.Add Type:=xlExpression, Formula1:="=" _
                      & Selection.Cells(1).Address(False, False) _
                      & "=MIN(" & Rango.Rows(1).Address(False, True) & ")"
                  'Assigning green color for the conditional formatting MIN
280               .FormatConditions(2).Interior.ColorIndex = 4
290               .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
300               .FormatConditions(2).StopIfTrue = False
310           End With
320       Else
330           MsgBox Rango.Address & " No es un rango valido"
340       End If
350       Range("A1").Select
360       On Error GoTo 0
370       Exit Sub
ConditionalFormatMinMaxValuesInARow_Error:
380       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub ConditionalFormatMinMaxValuesInARow, line " & Erl & "."
End Sub
Function IsValidAddress(strAddress As String) As Boolean
10        On Error GoTo IsValidAddress_Error
          Dim r As Range
20        Set r = Worksheets(1).Range(strAddress)
30        If Not r Is Nothing Then IsValidAddress = True
40        On Error GoTo 0
50        Exit Function
IsValidAddress_Error:
60        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IsValidAddress, line " & Erl & "."
End Function

No tienes los permisos requeridos para ver los archivos adjuntos a este mensaje.



Responder