Este fórum está sendo desativado

[SandroLima]

Boa noite.

Tenho uma macro que serve para organizar os dados de uma tabela baseado em "pendências",

As células da coluna [Registro] que possuem pendências apresentam coloração de preenchimento.

Na macro que eu uso atualmente as pendências eram baseadas nos dados da Coluna [Status Pgto] e o valor da variável LinCorte era dado pela contagem dessas "pendências" como pode ser visto no exemplo da macro abaixo:

Código: Selecionar todos

Sub Ordena_AtivDiarias()
   
    Set Plan = Sheets("ATIVIDADES DIARIAS")
    Set Tabela = Plan.ListObjects("TB_AtivDiarias")
    Set Aqui = ActiveCell
   
    TotalLin = Tabela.DataBodyRange.Rows.Count
    TotalCol = Tabela.DataBodyRange.Columns.Count
    IniLin = Tabela.DataBodyRange.Range("A1").Row
    IniCol = Tabela.DataBodyRange.Range("A1").Column
    UltLin = IniLin + TotalLin - 1
    UltCol = IniCol + TotalCol - 1
    ColReg = Tabela.ListColumns("Registro").DataBodyRange.Column
    ColData = Tabela.ListColumns("Data").DataBodyRange.Column
    ColVcto = Tabela.ListColumns("Pgto / Vencimento").DataBodyRange.Column
    ColStatus = Tabela.ListColumns("Status Pgto").DataBodyRange.Column
   
    LinCorte = Evaluate("CountIf(TB_AtivDiarias[[#All],[Status Pgto]],""Aguardando pagamento"") + " & _
                        "CountIf(TB_AtivDiarias[[#All],[Status Pgto]],""Valor retido"") + " & _
                        "CountIf(TB_AtivDiarias[[#All],[Status Pgto]],"""")") + IniLin - 1
...
End Sub 

Minha necessidade agora mudou... preciso que o valor da variável LinCorte seja a contagem das células da coluna [Registro] que apresentam coloração de preenchimento (qualquer coloração).
Poderiam me ajudar com essa parte da macro:

Código: Selecionar todos

LinCorte = Evaluate("CountIf(TB_AtivDiarias[[#All],[Status Pgto]],""Aguardando pagamento"") + " & _
                        "CountIf(TB_AtivDiarias[[#All],[Status Pgto]],""Valor retido"") + IniLin - 1

No caso do exemplo da planilha anexa o novo valor desejado para LinCorte é igual a 3... que é a contagem de células que apresentam cor de preenchimento na coluna [Registro]

Obrigado e boa noite a todos.

[babdallas]

Veja se é isso:

Código: Selecionar todos

Public Function iColor(rng As Range, Optional formatType As String) As Variant
'Função que peguei em
'https://stackoverflow.com/questions/45122782/how-to-get-the-background-color-from-a-conditional-formatting-in-excel-using-vba
'formatType: Hex for #RRGGBB, RGB for (R, G, B) and IDX for VBA Color Index
    Dim colorVal As Variant
    colorVal = rng.DisplayFormat.Interior.Color
    Select Case UCase(formatType)
        Case "HEX"
            iColor = "#" & Format(Hex(colorVal Mod 256), "00") & _
                           Format(Hex((colorVal \ 256) Mod 256), "00") & _
                           Format(Hex((colorVal \ 65536)), "00")
        Case "RGB"
            iColor = "(" & Format((colorVal Mod 256), "00") & "," & _
                     Format(((colorVal \ 256) Mod 256), "00") & "," & _
                     Format((colorVal \ 65536), "00") & ")"
        Case "IDX"
            iColor = rng.Interior.ColorIndex
        Case Else
            iColor = colorVal
    End Select
End Function

Sub Ordena_AtivDiarias()
    Set Tabela = wsh_AtivDiarias.ListObjects("TB_AtivDiarias")
                        
    With Tabela.ListColumns("Registro").DataBodyRange
        LinCorte = 0
        For lngLin = 1 To .Rows.Count
            For lngCol = 1 To .Columns.Count
                strRGB = iColor(.Cells(lngLin, lngCol), "RGB")
                If strRGB <> "(255,255,255)" And strRGB <> "(217,225,242)" Then
                        LinCorte = LinCorte + 1
                End If
            Next lngCol
        Next lngLin
    End With
                                          
    VBA.MsgBox LinCorte
    
    Set Tabela = Nothing
End Sub

[SandroLima]

Boa noite, babdallas.

Era exatamente isso... me ajudou muito com isso.

Muito obrigado.