Este fórum está sendo desativado

[Jamz]

Caros, estou precisando de F1 de vcs.

E o seguinte quero saber quantos vezes um números especifico se repeti em um conjunto, só que quero que conte apenas o número em que as células estão com uma determinada cor de preenchimento.

abraço.

[FelipeMGarcia]

Amigo, pra fazer o que deseja, vc vai precisar de uma função personalizada no Excel (UDF).

Segue código:

' Funções p/ contar e somar com base na cor da célula
' https://www.ablebits.com/office-addins- ... lor-excel/
' Domingos Junqueira 19/08/2016

Function ObterCorCélula(xlRange As Range)
Dim indRow, indColumn As Long
Dim arResults()

Application.Volatile

If xlRange Is Nothing Then
Set xlRange = Application.ThisCell
End If

If xlRange.Count > 1 Then
ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
For indRow = 1 To xlRange.Rows.Count
For indColumn = 1 To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color
Next
Next
ObterCorCélula = arResults
Else
ObterCorCélula = xlRange.Interior.Color
End If
End Function

Function ObterCorFonteCélula(xlRange As Range)
Dim indRow, indColumn As Long
Dim arResults()

Application.Volatile

If xlRange Is Nothing Then
Set xlRange = Application.ThisCell
End If

If xlRange.Count > 1 Then
ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
For indRow = 1 To xlRange.Rows.Count
For indColumn = 1 To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Font.Color
Next
Next
ObterCorFonteCélula = arResults
Else
ObterCorFonteCélula = xlRange.Font.Color
End If

End Function

Function ContaCélulaPorCor(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellCurrent As Range
Dim cntRes As Long

Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Interior.Color Then
cntRes = cntRes + 1
End If
Next cellCurrent

ContaCélulaPorCor = cntRes
End Function

Function SomaCélulaPorCor(rData As Range, cellRefColor As Range)
Dim indRefColor As Long
Dim cellCurrent As Range
Dim sumRes

Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Interior.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
End If
Next cellCurrent

SomaCélulaPorCor = sumRes
End Function

Function ContaCélulaPorCorDaFonte(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellCurrent As Range
Dim cntRes As Long

Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Font.Color Then
cntRes = cntRes + 1
End If
Next cellCurrent

ContaCélulaPorCorDaFonte = cntRes
End Function

Function SomaCélulaPorCorDaFonte(rData As Range, cellRefColor As Range)
Dim indRefColor As Long
Dim cellCurrent As Range
Dim sumRes

Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Font.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
End If
Next cellCurrent

SomaCélulaPorCorDaFonte = sumRes
End Function

Depois de colar esta função no Editor de Macros, vc faz = somacélulaporCordaFonte(intervalo que tem os dados;critério), por exemplo:

=ContaCélulaPorCorDaFonte(A5:A17;A7) no seu arquivo.

Abs

[FelipeMGarcia]

Segue o arquivo com a função.

Abs

[FelipeMGarcia]

=ContaCélulaPorCor(A5:A17;A7), essa é a correta.

[osvaldomp]

Experimente esta:

Código: Selecionar todos

Function Conta3()
 Dim r As Range
  Application.Volatile
  For Each r In Range("A5:A" & Cells(Rows.Count, 1).End(3).Row)
   If r.Value = 3 And r.Interior.Color = 65535 Then Conta3 = Conta3 + 1
  Next r
End Function

E em qualquer célula vazia coloque =conta3()

Anexei uma cópia do seu arquivo com a UDF instalada.