Colorir maior valor de uma série

2024 - VBA & Macros

Post Recente por Fernando Fernandes 12 anos atrás

5 Posts

2 Usuários

0 Reactions

891 Visualizações

RSS

rrp1989

(@rrp1989)

Posts: 4

New Member

Topic starter

Bom dia,

Estou tentando criar uma função que retone na própria célula o maior valor de um Range e pinte de uma cor qualquer a célula onde está este valor.

Tentei da seguinte forma:

Function ColorirMaior(Celula As Range) As Integer
Dim Aux As Integer
Dim CelulaAux As Range
Aux = 1

    Do While Celula.Cells.Count > Aux
        If Celula(Aux) > Celula(Aux - 1) Then
        CelulaAux = Celula(Aux)
        End If
        Aux = Aux + 1
    Loop
    
CelulaAux.Cells.Interior.Color = vbCyan
ColorirMaior = CelulaAux.Value

End Function

Como resultado estou tendo um retorno do tipo #VALOR na célula original e nada ocorre no Range selecionado.

Alguém poderia me ajudar?

Att,
Rodrigo

Postado : 30/10/2012 9:02 am

rrp1989

(@rrp1989)

Posts: 4

New Member

Topic starter

Só acrescentando mais alguns dados:

Tentei usar a formatação condicional, pelo menos para a parte de colorir a célula, mas não consegui fazer a comparação pq, além de valores tenho registros do tipo #N/D que trataria através da função e que não consegui tratar através da Formatação Condicional do Excel 2003

Postado : 30/10/2012 9:09 am

rrp1989

(@rrp1989)

Posts: 4

New Member

Topic starter

Através do seguinte código consegui colocar o maior valor de uma seleção na célula onde a fórmula é digitada:

Function ColorirMaior(Celula As Range) As Double
Dim aux As Integer
Dim aux2 As Integer
Dim posicao As Integer
Dim CelulaAux As Variant
Dim linhasCont As Integer
Dim colunasCont As Integer
Dim conteudo As Variant
CelulaAux = 0
linhasCont = Celula.Rows.Count
colunasCont = Celula.Columns.Count
conteudo = Celula.Value

    For aux = 1 To linhasCont
        For aux2 = 1 To colunasCont
            If conteudo(aux, aux2) > CelulaAux Then
                CelulaAux = conteudo(aux, aux2)
            End If
        Next aux2
    Next aux

ColorirMaior = CelulaAux

End Function

Entretanto, o problema para colorir a célula persiste... O que eu quero colorir é a célula original onde está o maior valor encontrado.

Tentei, dentre outras, as seguintes formas:

'CelulaAux.Cells.Interior.Color = vbCyan
'Celula.Cells.Interior.Color = vbCyan
'cor(1, posicao) = vbCyan
'ActiveCell.Interior.ColorIndex = 36
'ActiveCell.Interior.Pattern = xlSolid
'Celula.Select
    'With Selection.Interior
     '   .ColorIndex = 3
     '   .Pattern = xlSolid
   'End With

Postado : 31/10/2012 12:00 pm

rrp1989

(@rrp1989)

Posts: 4

New Member

Topic starter

Consegui resolver o meu problema, mas não através de uma função

Tive que fazer uma Sub para resolução do problema, pois não estava conseguindo colorir de jeito nenhum através de uma função.

Para aqueles que procurarem futuramente sobre o mesmo problema, segue o código que colore o maior valor de cada uma das linhas selecionadas:

Sub ColorirMaiorLinha()

Dim aux As Integer
Dim aux2 As Integer
Dim posicaoLinha As Integer
Dim posicaoColuna As Integer
Dim CelulaAux As Variant
Dim linhasCont As Integer
Dim colunasCont As Integer
Dim conteudo As Variant
Dim Celula As Range
Set Celula = Selection
CelulaAux = 0
linhasCont = Celula.Rows.Count
colunasCont = Celula.Columns.Count
conteudo = Celula.Value

    For aux = 1 To linhasCont
        For aux2 = 1 To colunasCont
        If IsNumeric(conteudo(aux, aux2)) Then
            If conteudo(aux, aux2) > CelulaAux Then
                CelulaAux = conteudo(aux, aux2)
                posicaoLinha = aux
                posicaoColuna = aux2
            End If
        End If
        Next aux2
        Celula.Cells(posicaoLinha, posicaoColuna).Interior.Color = vbCyan
        CelulaAux = 0
    Next aux


End Sub

Se eu quisesse colorir o maior de todas as linhas eu teria o código:

Sub ColorirMaior()
 
Dim aux As Integer
Dim aux2 As Integer
Dim posicaoLinha As Integer
Dim posicaoColuna As Integer
Dim CelulaAux As Variant
Dim linhasCont As Integer
Dim colunasCont As Integer
Dim conteudo As Variant
Dim Celula As Range
Set Celula = Selection
CelulaAux = 0
linhasCont = Celula.Rows.Count
colunasCont = Celula.Columns.Count
conteudo = Celula.Value
 
    For aux = 1 To linhasCont
        For aux2 = 1 To colunasCont
        If IsNumeric(conteudo(aux, aux2)) Then
            If conteudo(aux, aux2) > CelulaAux Then
                CelulaAux = conteudo(aux, aux2)
                posicaoLinha = aux
                posicaoColuna = aux2
            End If
        End If
        Next aux2
    Next aux
 
Celula.Cells(posicaoLinha, posicaoColuna).Interior.Color = vbCyan
End Sub

Postado : 31/10/2012 3:41 pm