Excel vba - loop dentro de loop

JTABATA · 1 de dezembro de 2022

Prezados,

Criei um código para calcular valores baseados em alguns critérios e o código está me ajudando muito. Todavia, necessito criar um "loop" ( talvez um "do while" ) para o continuar calculando.

No formulário abaixo, defino mês e os dias de estoques e a produção é definida ( atingir meta > goalseek ) com base em critério definidos.

Porém, é calculado apenas um mês ( mês de referência apenas )

Se possível, após escolher a opção "Anual ", gostaria que os outros meses ( até a achar a célula em branco ) fossem calculados de forma continua.

Acredito que a adição do "Do while activecell.value<>""" já resolveria o problema, porém não estou conseguindo "alinhar" os loops.

Ficaria muito agradecido, caso alguém possa me ajudar.

Grande abraço a todos,

Grato,

( Não consegui anexar a planilha !!! )

Sub BMES_Click()

Worksheets("producao anual").Activate
For i = 2 To 104
'Verifica se a opção do mês e o indice de estoque está OK
If Me.cc.Value = "" And Me.TXTdias.Value <> "" Then
MsgBox "Por favor,escolha um mês para a realização do calculo !!", vbCritical, "Planejamento & Controle de Produção"
Exit Sub
'Verifica se  o indice de estoque está OK
ElseIf Me.cc.Value <> "" And Me.TXTdias.Value = "" Then
MsgBox "Por favor,escolha a quantidade de dias de estoque", vbCritical, "Planejamento & Controle de Produção"
Exit Sub
'Verifica se as duas opções estão OK
ElseIf Me.cc.Value = "" And Me.TXTdias.Value = "" Then
MsgBox "Por favor,informe o mês da produção e a quantidade de dias de estoque !", vbCritical, "Planejamento & Controle de Produção"
Exit Sub
End If
'Calcula o índice de estoques
Set c = Sheets("producao anual").Range("J3:EU3").Find(what:=Me.cc.Value)
If c.Offset(i, 10).Value = 0 Then
c.Offset(i, 6).Value = 0
ElseIf c.Offset(i, 12).Value = "B" Then
c.Offset(i, 9).GoalSeek goal:=0.5, changingcell:=c.Offset(i, 6)
'Calcula a produção dos itens "A"
ElseIf c.Offset(i, 12).Value = "A" Then
c.Offset(i, 8).GoalSeek goal:=c.Offset(i, 10).Value / c.Offset(0, 18).Value * Me.TXTdias.Value, changingcell:=c.Offset(i, 6)

'----------------------------------------------------------------
ElseIf c.Offset(i, 12).Value = "C" Then
c.Offset(i, 9).GoalSeek goal:=1, changingcell:=c.Offset(i, 6)
End If
If c.Offset(i, 8).Value < 0 Then
c.Offset(i, 8).GoalSeek goal:=0, changingcell:=c.Offset(i, 6)
End If
 Next i
 Unload Me
 c.Offset(2, 7).Select
 ActiveCell.Resize(104, 1).Copy
 ActiveCell.Offset(0, -1).PasteSpecial xlPasteValues
 Application.CutCopyMode = False
c.Offset(0, 10).Select     'Seleciona o próximo mês

 End Sub

Midori · 1 de dezembro de 2022

1 hora atrás, JTABATA disse:

( Não consegui anexar a planilha !!! )

Com macro só dá para anexar o arquivo compactado.

JTABATA · 1 de dezembro de 2022

Caros,

Segue o arquivo compactado !

Obrigado !PPCP-2023 TESTE.zip

Midori · 2 de dezembro de 2022

@JTABATA Sua macro está com erro no mês de novembro, não verifiquei o motivo.

O loop pode ser no combobox que já tem os meses.

Coloquei os cálculos em outro procedimento para fazer a chamada nos dois critérios, anual e mensal.

Sub BMES_Click()
Dim C As Range
Dim Producao    As Worksheet

Set Producao = Worksheets("producao anual")
    Producao.Activate

If Me.TXTdias.Value = "" Then
    MsgBox "Por favor,escolha a quantidade de dias de estoque", _
        vbCritical, "Planejamento & Controle de Produção"
    Exit Sub

Else
    If OBtrez.Value = True Then
        If Me.cc.Value = "" Then
            'Verifica se a opção do mês está OK
            MsgBox "Por favor,escolha um mês para a realização do calculo !!", _
                vbCritical, "Planejamento & Controle de Produção"
            Exit Sub
        End If
    
        Set C = Producao.Range("J3:EU3").Find(What:=Me.cc.Value)
        Call CalculaObjetivo(C, Me.TXTdias.Value)
        C.Offset(2, 7).Select
        ActiveCell.Resize(104, 1).Copy
        ActiveCell.Offset(0, -1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        C.Offset(0, 10).Select
    Else
        Dim iMes As Integer
    
        For iMes = 0 To cc.ListCount - 1
            Set C = Producao.Range("J3:EU3").Find(What:=Me.cc.List(iMes))
            Call CalculaObjetivo(C, Me.TXTdias.Value)
        Next iMes
    End If
End If

Unload Me

End Sub

Sub CalculaObjetivo(RefMes As Range, Dias As Integer)
    Dim I As Integer
    Dim C As Range
    
    Set C = RefMes
    
    For I = 2 To 104
        If C.Offset(I, 10).Value = 0 Then
            C.Offset(I, 6).Value = 0
        ElseIf C.Offset(I, 12).Value = "B" Then
            Call C.Offset(I, 9).GoalSeek(Goal:=0.5, ChangingCell:=C.Offset(I, 6))
            'Calcula a produção dos itens "A"
        ElseIf C.Offset(I, 12).Value = "A" Then
            Call C.Offset(I, 8).GoalSeek( _
                Goal:=C.Offset(I, 10).Value / C.Offset(0, 18).Value * Dias, _
                ChangingCell:=C.Offset(I, 6))
        ElseIf C.Offset(I, 12).Value = "C" Then
            Call C.Offset(I, 9).GoalSeek(Goal:=1, ChangingCell:=C.Offset(I, 6))
        End If

        If C.Offset(I, 8).Value < 0 Then
            Call C.Offset(I, 8).GoalSeek(Goal:=0, ChangingCell:=C.Offset(I, 6))
        End If
    Next I
End Sub