Preciso fazer uma auditoria onde tenho 646 dados, e esses dados são dividios de 3 em 3 repetições, dentro dessas repetições preciso identificar se há uma diferença de 30% acima ou abaixo, e quando houver essa diferença gostaria que essa celula ficasse pintada, tentei esse código mas n funcionou e não consegui resolver. Se tiver outra forma de fazer q n seja por formatacao condicional tb poderia ser uma boa
Sub FormatacaoCondicionalTresCelulas()
Dim rng As Range
Dim cell As Range
Dim lastRow As Long
' Defina o intervalo de células onde deseja aplicar a formatação condicional
Set rng = Range("AI2:AI646" & Cells(Rows.Count, 2).End(xlUp).Row)
' Determina a última linha com dados
lastRow = rng.Rows.Count + rng.Row - 1
' Loop através do intervalo de células, pulando de 3 em 3 células
For i = 1 To lastRow Step 3
If i + 2 <= lastRow Then
Dim value1 As Double
Dim value2 As Double
Dim value3 As Double
If diff1 >= 0.3 Or diff2 >= 0.3 Or diff3 >= 0.3 Then
rng.Range(rng.Cells(i, 1), rng.Cells(i + 2, 1)).Interior.Color = RGB(255, 0, 0) ' Cor para conjuntos com diferença de 30% ou mais
Pergunta
Renata Schroeder
Preciso fazer uma auditoria onde tenho 646 dados, e esses dados são dividios de 3 em 3 repetições, dentro dessas repetições preciso identificar se há uma diferença de 30% acima ou abaixo, e quando houver essa diferença gostaria que essa celula ficasse pintada, tentei esse código mas n funcionou e não consegui resolver. Se tiver outra forma de fazer q n seja por formatacao condicional tb poderia ser uma boa
Sub FormatacaoCondicionalTresCelulas()
Dim rng As Range
Dim cell As Range
Dim lastRow As Long
' Defina o intervalo de células onde deseja aplicar a formatação condicional
Set rng = Range("AI2:AI646" & Cells(Rows.Count, 2).End(xlUp).Row)
' Determina a última linha com dados
lastRow = rng.Rows.Count + rng.Row - 1
' Loop através do intervalo de células, pulando de 3 em 3 células
For i = 1 To lastRow Step 3
If i + 2 <= lastRow Then
Dim value1 As Double
Dim value2 As Double
Dim value3 As Double
value1 = rng.Cells(i, 1).Value
value2 = rng.Cells(i + 1, 1).Value
value3 = rng.Cells(i + 2, 1).Value
Dim diff1 As Double
Dim diff2 As Double
Dim diff3 As Double
' Calcula as diferenças percentuais
If value1 <> 0 Then
diff1 = Abs((value2 - value1) / value1)
diff2 = Abs((value3 - value2) / value2)
diff3 = Abs((value3 - value1) / value1)
If diff1 >= 0.3 Or diff2 >= 0.3 Or diff3 >= 0.3 Then
rng.Range(rng.Cells(i, 1), rng.Cells(i + 2, 1)).Interior.Color = RGB(255, 0, 0) ' Cor para conjuntos com diferença de 30% ou mais
End If
End If
End If
Next i
End Sub
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.