Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Formatação condicio...
 
Notifications
Clear all

Formatação condicional em vba

 
2024 - VBA & Macros
2 Posts
2 Usuários
0 Reactions
925 Visualizações
RSS
 robertonl
(@robertonl)
Posts: 121
Estimable Member
Topic starter
 

A macro abaixo funcionou, porem alguém tem ideia de como reduzir o código abaixo:

Sub Teste_Macro()

Dim I As Integer
Dim J As Integer
'Dim  As Integer
Dim w As Worksheet
Dim senha As String
senha = "123"
J = 1
Set w = Planilha3
w.Activate

If w.ProtectContents = True Then

w.Unprotect senha

End If

FinalRow = Cells(Rows.Count, 3).End(xlUp).Row

On Error Resume Next
'Planilha4.Cells(I, 2).ClearContents
For I = 3 To FinalRow
'Planilha6.Cells(I, 2).Clear
'Cells(I, 2) = Application.WorksheetFunction.VLookup(Cells(I, 3), Worksheets("Materia Prima").Range("B2:e400"), 3, 0)
 
If Planilha3.Cells(I, 9) < Planilha3.Cells(I, 7) Then
   Planilha3.Cells(I, 10) = J - (Planilha3.Cells(I, 9) / Planilha3.Cells(I, 7))
   Planilha3.Cells(I, 11) = "Abaixo do Estoque Mínimo"
   Planilha3.Cells(I, 1) = " CRÍTICO "
   Planilha3.Cells(I, 1).Interior.ColorIndex = 3
   Planilha3.Cells(I, 1).Font.ColorIndex = 2
   Planilha3.Cells(I, 1).Characters.Font.Bold = True
   Planilha3.Cells(I, 2).Interior.ColorIndex = 3
   Planilha3.Cells(I, 2).Font.ColorIndex = 2
   Planilha3.Cells(I, 2).Characters.Font.Bold = True
   Planilha3.Cells(I, 3).Interior.ColorIndex = 3
   Planilha3.Cells(I, 3).Font.ColorIndex = 2
   Planilha3.Cells(I, 3).Characters.Font.Bold = True
   Planilha3.Cells(I, 4).Interior.ColorIndex = 3
   Planilha3.Cells(I, 4).Font.ColorIndex = 2
   Planilha3.Cells(I, 4).Characters.Font.Bold = True
   Planilha3.Cells(I, 5).Interior.ColorIndex = 3
   Planilha3.Cells(I, 5).Font.ColorIndex = 2
   Planilha3.Cells(I, 5).Characters.Font.Bold = True
   Planilha3.Cells(I, 6).Interior.ColorIndex = 3
   Planilha3.Cells(I, 6).Font.ColorIndex = 2
   Planilha3.Cells(I, 6).Characters.Font.Bold = True
   Planilha3.Cells(I, 7).Interior.ColorIndex = 3
   Planilha3.Cells(I, 7).Font.ColorIndex = 2
   Planilha3.Cells(I, 7).Characters.Font.Bold = True
   Planilha3.Cells(I, 8).Interior.ColorIndex = 3
   Planilha3.Cells(I, 8).Font.ColorIndex = 2
   Planilha3.Cells(I, 8).Characters.Font.Bold = True
   Planilha3.Cells(I, 9).Interior.ColorIndex = 3
   Planilha3.Cells(I, 9).Font.ColorIndex = 2
   Planilha3.Cells(I, 9).Characters.Font.Bold = True
   Planilha3.Cells(I, 10).Interior.ColorIndex = 3
   Planilha3.Cells(I, 10).Font.ColorIndex = 2
   Planilha3.Cells(I, 10).Characters.Font.Bold = True
   Planilha3.Cells(I, 11).Interior.ColorIndex = 3
   Planilha3.Cells(I, 11).Font.ColorIndex = 2
   Planilha3.Cells(I, 11).Characters.Font.Bold = True
   Else
    If Planilha3.Cells(I, 9) > Planilha3.Cells(I, 8) Then
        Planilha3.Cells(I, 10) = (Planilha3.Cells(I, 9) / Planilha3.Cells(I, 8)) - J
        Planilha3.Cells(I, 11) = "Acima do Estoque Máximo"
        Planilha3.Cells(I, 1) = " "
        Planilha3.Cells(I, 1).Interior.ColorIndex = 2
        Planilha3.Cells(I, 1).Font.ColorIndex = 1
        Planilha3.Cells(I, 1).Characters.Font.Bold = True
        Planilha3.Cells(I, 2).Interior.ColorIndex = 2
        Planilha3.Cells(I, 2).Font.ColorIndex = 1
        Planilha3.Cells(I, 2).Characters.Font.Bold = True
        Planilha3.Cells(I, 3).Interior.ColorIndex = 2
        Planilha3.Cells(I, 3).Font.ColorIndex = 1
        Planilha3.Cells(I, 3).Characters.Font.Bold = True
        Planilha3.Cells(I, 4).Interior.ColorIndex = 2
        Planilha3.Cells(I, 4).Font.ColorIndex = 1
        Planilha3.Cells(I, 4).Characters.Font.Bold = True
        Planilha3.Cells(I, 5).Interior.ColorIndex = 2
        Planilha3.Cells(I, 5).Font.ColorIndex = 1
        Planilha3.Cells(I, 5).Characters.Font.Bold = True
        Planilha3.Cells(I, 6).Interior.ColorIndex = 2
        Planilha3.Cells(I, 6).Font.ColorIndex = 1
        Planilha3.Cells(I, 6).Characters.Font.Bold = True
        Planilha3.Cells(I, 7).Interior.ColorIndex = 2
        Planilha3.Cells(I, 7).Font.ColorIndex = 1
        Planilha3.Cells(I, 7).Characters.Font.Bold = True
        Planilha3.Cells(I, 8).Interior.ColorIndex = 2
        Planilha3.Cells(I, 8).Font.ColorIndex = 1
        Planilha3.Cells(I, 8).Characters.Font.Bold = True
        Planilha3.Cells(I, 9).Interior.ColorIndex = 2
        Planilha3.Cells(I, 9).Font.ColorIndex = 1
        Planilha3.Cells(I, 9).Characters.Font.Bold = True
        Planilha3.Cells(I, 10).Interior.ColorIndex = 2
        Planilha3.Cells(I, 10).Font.ColorIndex = 1
        Planilha3.Cells(I, 10).Characters.Font.Bold = True
        Planilha3.Cells(I, 11).Interior.ColorIndex = 2
        Planilha3.Cells(I, 11).Font.ColorIndex = 1
        Planilha3.Cells(I, 11).Characters.Font.Bold = True
  End If
End If
Next I
w.Protect senha
End Sub
 
Postado : 23/11/2017 10:01 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Não testado!

Sub Teste_Macro()

Dim I As Integer
Dim J As Integer
'Dim  As Integer
Dim w As Worksheet
Dim senha As String
senha = "123"
J = 1
Set w = Planilha3
w.Activate
    If w.ProtectContents = True Then
        w.Unprotect senha
    End If
FinalRow = Cells(Rows.Count, 3).End(xlUp).Row

On Error Resume Next
For I = 3 To FinalRow
    With Planilha3
        If .Cells(I, 9) < .Cells(I, 7) Then
           .Cells(I, 10) = J - (.Cells(I, 9) / .Cells(I, 7))
           .Cells(I, 11) = "Abaixo do Estoque Mínimo"
           .Cells(I, 1) = " CRÍTICO "
           .Cells(I, 1).Resize(, 11).Interior.ColorIndex = 3
           .Cells(I, 1).Resize(, 11).Font.ColorIndex = 2
        Else
    If .Cells(I, 9) > .Cells(I, 8) Then
        .Cells(I, 10) = (.Cells(I, 9) / .Cells(I, 8)) - J
        .Cells(I, 11) = "Acima do Estoque Máximo"
        .Cells(I, 1) = " "
        .Cells(I, 1).Resize(, 11).Interior.ColorIndex = 2
        .Cells(I, 1).Resize(, 11).Font.ColorIndex = 1
    End If
        End If
    End With
Next I
w.Protect senha
End Sub

Favor testar!!

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 23/11/2017 11:05 am
Forum Jump:
  Tópico Anterior
Próximo Tópico