Uma loja de chapéus pretende fazer uma promoção para o Black Friday, mas antes de baixar seus preços, o lojista resolve reajustá-los para cima a fim de não reduzir muito a sua margem, seguindo a regra abaixo:
Após aplicar estes aumentos ele decidiu o valor dos descontos seguindo a regra abaixo:
Após identificar o preço final com o desconto, compare com o preço inicial e sublinhe de verde os produtos em que o "desconto" realmente reduziu o preço.
Exercício Resolvido
Resolvendo o Problema
Com base no preço atual do produto o enquadramos em algum dos critérios de aumento de preço sugeridos pelo problema
-
Iniciamos o problema declarando as variáveis e encontrando a última linha que possui dados
Dim UltLinha As Long
Dim i As Integer
Dim ReaJuste As Variant
Dim DisConto As Variant
UltLinha = Cells(Rows.Count, 2).End(xlUp).Row
-
Criamos o loop For Next até a última linha e atrelamos a célula do loop a um Select Case para reajustar o preço dos produtos conforme o caso.
For i = 3 To UltLinha
Select Case Cells(i, 2).Value
Case 25 To 50
ReaJuste = 0.15
Cells(i, 3).Value = Cells(i, 2).Value * ReaJuste
Case 51 To 100
ReaJuste = 0.25
Cells(i, 3).Value = Cells(i, 2).Value * ReaJuste
Case 101 To 150
ReaJuste = 0.35
Cells(i, 3).Value = Cells(i, 2).Value * ReaJuste
End Select
-
Como as células na planilha já estão atreladas para encontrar o preço aumentado assim que o valor do reajuste seja calculado, podemos a partir deste preço calcular o desconto ainda no mesmo loop.
Select Case Cells(i, 4).Value
Case 25 To 75
DisConto = 0.1
Cells(i, 5).Value = Cells(i, 4).Value * DisConto
Case 76 To 125
DisConto = 0.175
Cells(i, 5).Value = Cells(i, 4).Value * DisConto
Case 126 To 150
DisConto = 0.25
Cells(i, 5).Value = Cells(i, 4).Value * DisConto
Case Is > 150
DisConto = 0.3
Cells(i, 5).Value = Cells(i, 4).Value * DisConto
End Select
-
Por fim, criamos um condicional para determinar se o desconto realmente ocorreu, e em caso positivo colorimos a célula de verde.
If Cells(i, 7).Value < Cells(i, 2).Value Then
Cells(i, 7).Interior.Color = RGB(140, 198, 63)
End If
Next i
Código Consolidado
Sub Resolucao()
Dim UltLinha As Long
Dim i As Integer
Dim ReaJuste As Variant
Dim DisConto As Variant
UltLinha = Cells(Rows.Count, 2).End(xlUp).Row
For i = 3 To UltLinha
Select Case Cells(i, 2).Value
Case 25 To 50
ReaJuste = 0.15
Cells(i, 3).Value = Cells(i, 2).Value * ReaJuste
Case 51 To 100
ReaJuste = 0.25
Cells(i, 3).Value = Cells(i, 2).Value * ReaJuste
Case 101 To 150
ReaJuste = 0.35
Cells(i, 3).Value = Cells(i, 2).Value * ReaJuste
End Select
Select Case Cells(i, 4).Value
Case 25 To 75
DisConto = 0.1
Cells(i, 5).Value = Cells(i, 4).Value * DisConto
Case 76 To 125
DisConto = 0.175
Cells(i, 5).Value = Cells(i, 4).Value * DisConto
Case 126 To 150
DisConto = 0.25
Cells(i, 5).Value = Cells(i, 4).Value * DisConto
Case Is > 150
DisConto = 0.3
Cells(i, 5).Value = Cells(i, 4).Value * DisConto
End Select
If Cells(i, 7).Value < Cells(i, 2).Value Then
Cells(i, 7).Interior.Color = RGB(140, 198, 63)
End If
Next i
End Sub
SuperExcelVBA.com é um site voltado ao aprendizado de VBA. Exemplos e explicações podem ter sido simplificados para maior e mais veloz compreensão. Estamos constantemente nos atualizando e corrigindo erros, porém não existe garantia sobre o conteúdo disponível no site. Todos os direitos reservados.
Excel ® é uma marca registrada da Microsoft Corporation.
© 2025 SuperExcelVBA | SOBRE
