Este fórum está sendo desativado

[Luc]

Bom dia pessoal,

Criei um código para formatação condicional.

As células a serem condicionadas funcionam assim:

E4, G4, I4........ATÉ AC4
E6, G6, I6........ATÉ AC6

E vai assim até a linha 72

Todas essas células estão preenchidas com os meses.

Quando a célula AN4 > 0 a célula E4 é condicionada e assim por diante.

O código é esse:

Código: Selecionar todos

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Range("AN4") > 0 Then
        Range("E4").Interior.Color = RGB(153, 255, 51)
        Range("E4").Font.Italic = True
        Range("E4").Font.ColorIndex = 21
        Range("E4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AO4") > 0 Then
        Range("G4").Interior.Color = RGB(153, 255, 51)
        Range("G4").Font.Italic = True
        Range("G4").Font.ColorIndex = 21
        Range("G4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AP4") > 0 Then
        Range("I4").Interior.Color = RGB(153, 255, 51)
        Range("I4").Font.Italic = True
        Range("I4").Font.ColorIndex = 21
        Range("I4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AQ4") > 0 Then
        Range("K4").Interior.Color = RGB(153, 255, 51)
        Range("K4").Font.Italic = True
        Range("K4").Font.ColorIndex = 21
        Range("K4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AR4") > 0 Then
        Range("M4").Interior.Color = RGB(153, 255, 51)
        Range("M4").Font.Italic = True
        Range("M4").Font.ColorIndex = 21
        Range("M4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AS4") > 0 Then
        Range("O4").Interior.Color = RGB(153, 255, 51)
        Range("O4").Font.Italic = True
        Range("O4").Font.ColorIndex = 21
        Range("O4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AT4") > 0 Then
        Range("Q4").Interior.Color = RGB(153, 255, 51)
        Range("Q4").Font.Italic = True
        Range("Q4").Font.ColorIndex = 21
        Range("Q4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AU4") > 0 Then
        Range("S4").Interior.Color = RGB(153, 255, 51)
        Range("S4").Font.Italic = True
        Range("S4").Font.ColorIndex = 21
        Range("S4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AV4") > 0 Then
        Range("U4").Interior.Color = RGB(153, 255, 51)
        Range("U4").Font.Italic = True
        Range("U4").Font.ColorIndex = 21
        Range("U4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AW4") > 0 Then
        Range("W4").Interior.Color = RGB(153, 255, 51)
        Range("W4").Font.Italic = True
        Range("W4").Font.ColorIndex = 21
        Range("W4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AX4") > 0 Then
        Range("Y4").Interior.Color = RGB(153, 255, 51)
        Range("Y4").Font.Italic = True
        Range("Y4").Font.ColorIndex = 21
        Range("Y4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AY4") > 0 Then
        Range("AA4").Interior.Color = RGB(153, 255, 51)
        Range("AA4").Font.Italic = True
        Range("AA4").Font.ColorIndex = 21
        Range("AA4").Font.Underline = xlUnderlineStyleSingle
    End If
    If Range("AZ4") > 0 Then
        Range("AC4").Interior.Color = RGB(153, 255, 51)
        Range("AC4").Font.Italic = True
        Range("AC4").Font.ColorIndex = 21
        Range("AC4").Font.Underline = xlUnderlineStyleSingle
    End If

Isso foi só para a linha 4. Imagine para 72 linhas.

Ficou grande demais. Preciso reduzir o tamanho para que o Excel entenda.

Segue um exemplo reduzido:

[Herika]

Oi....
Não entendi por que fazer isso por macro e não através da formatação condicional....

[ExcelFlex]

Eu fiz o que você precisava usando apenas formatação condicional, sem macros.
Foi criada apenas 1 regra que se aplica a toda a planilha.

Att,

Marcus.

[Luc]

Marcus,

Muito bom. Esse era o problema, criar uma condicional que servisse para toda a planilha.

Da forma como eu sabia fazer seria uma condicional para cada célula.

Também encontrei a solução com essa macro aqui:

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim i As Integer
    Dim j As Integer
   
    
    On Error Resume Next
   
    
    If Not Application.Intersect(Target, [AN4:AZ72]) Is Nothing Then
   
        
        For i = 4 To 72 Step 2
           
            
            For j = 40 To 52
               
                
                If Cells(i, j).Value > 0 Then
                   
                    
                    Cells(i, (j - 40) * 2 + 5).Interior.Color = RGB(153, 255, 51)
                    Cells(i, (j - 40) * 2 + 5).Font.Italic = True
                    Cells(i, (j - 40) * 2 + 5).Font.ColorIndex = 21
                    Cells(i, (j - 40) * 2 + 5).Font.Underline = xlUnderlineStyleSingle
                Else
                    
                    Cells(i, (j - 40) * 2 + 5).Interior.Color = 16764057
                    Cells(i, (j - 40) * 2 + 5).Font.Italic = False
                    Cells(i, (j - 40) * 2 + 5).Font.ColorIndex = 0
                    Cells(i, (j - 40) * 2 + 5).Font.Underline = xlUnderlineStyleNone
                End If
            Next
        Next
    End If
End Sub

Todos os 2 modelos funcionam corretamente.

Obrigado!