Este fórum está sendo desativado

[Angra]

Alô Pessoal
A lista atual utiliza formula mas precisava de uma macro para ficar mais ágil. A macro gera de modo aleatório, sempre obedecendo os parâmetros dos valores a serem gerados. Em M8 informo a soma pretendida de todos os valores gerados em I4:U6.
No exemplo acima, simulo com a formula: =ÍNDICE($A$4:$B$4;ALEATÓRIOENTRE(1;2)) o pretendido. (pressionando F9)
Mas não tem como controlar a soma.

[DJunqueira]

Vc poderia usar Atingir Meta em Dados / Teste de Hipóteses / Atingir Meta...

[Angra]

No caso especifico uma macro teria aproveitamento melhor

[sonymartins]

Olá amigo,

resolvi boa parte do seu problema, até que foi divertido.

Segue abaixo o anexo.

Insira o seguinte código na sua planilha:

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim minimo As Integer, maximo As Integer
    
    ' calcula os valores minimo possível e máximo possível para a soma evitando cair em um loop infinito
    minimo = Range("I4:U4").Count * Application.WorksheetFunction.Min(Range("A4:B4")) _
           + Range("I5:U5").Count * Application.WorksheetFunction.Min(Range("A5:B5")) _
           + Range("I6:U6").Count * Application.WorksheetFunction.Min(Range("A6:B6"))
        
    maximo = Range("I4:U4").Count * Application.WorksheetFunction.Max(Range("A4:B4")) _
           + Range("I5:U5").Count * Application.WorksheetFunction.Max(Range("A5:B5")) _
           + Range("I6:U6").Count * Application.WorksheetFunction.Max(Range("A6:B6"))
    
    ' verifica se a célula A8 foi modificada
     If Target.Address = "$A$8" Then
        'verifica se a célula A8 está vazia
        If Range(Target.Address).Value = "" Then
        MsgBox "Defina um valor para a soma"
        'verifica se o valor informado para a soma está entre os limites
        ElseIf Range("$A$8").Value < minimo Or Range("$A$8").Value > maximo Then
            MsgBox "Defina um valor entre " & minimo & " e " & maximo
            Else
            'atualiza o sistema (tipo F9) até que o valor da soma resulte na valor escolhido
            Do While Range("M8") <> Range("A8")
            ActiveSheet.EnableCalculation = False
            ActiveSheet.EnableCalculation = True
            Loop
        End If
    End If
End Sub

Com isso vc conseguirá forçar o sistema a encontrar uma combinação de valores que resulte na soma pretendida. Este valor eu deixo marcado na célula A8. Mais detalhes estão na planilha.

Até.

[Angra]

Certim, do jeito que precisava Meo obrigado