Guru do Excel e Power BI

Enviado: **29 Nov 2018 às 15:09**

Olá colegas,

Estou tentando criar um código VBA para resolver um problema que se parece muito com um cadeado de segredo.
Eu tenho 3 linhas com números de 0 a 9 e gostaria de testar todas as possíveis combinações e que o VBA interrompa o processo quando o número alvo que eu informar seja atingido.
O número alvo deve ser o maior número da soma das colunas combinadas.
Eu já escrevi as macros 1, 2 e 3 que fazem as células avançarem para a direita.
Agora estou penando para fazer um loop que teste cada combinação e interrompa o processo quando encontrar o valor desejado.

Enviado: **29 Nov 2018 às 20:29**

Nao abri a planilha mas um if resolve

Sub testacodigo()
Dim Codigo as long
Dim Valorpesquisado as long

Codigo = range("A1").value 'Este é o valor da sua senha
Valorpesquisado = range("A2").value 'Este é o valor gerado pelo codigo que fica armazendo na celula

if valorpesquisado = codigo then
msgbox "Senha encontrada"
Exit sub
end if

end sub

Nao vi sua planilha mas o codigo que vc deve usar é proximo desse

Enviado: **30 Nov 2018 às 11:49**

ainda não funcionou, falta um comando para testar todas as combinações.

Eu nao escrevi o codigo completo como havia falado nao vi sua planilha naquele momento.

Agora abri sua planilha mas nao entendi o que deve ser comparado com o que.

Realmente nao entendi seu processo.

O loop so deve se preocupar se a soma das variaveis a b c é maior do que o valor alvo??

No seu exemplo o alvo é 18.

Se a soma de a + b + c for 19 interrompe o codigo e grava em D12?

É isso??

Olá Mprudencio,

"Alvo" é o valor que eu estou procurando.
"Maior" é o maior valor da soma das linhas A, B e C.

Se o "Alvo" for diferente do "Maior", então executar um loop (ou outro método) para testar as possíveis combinações, até encontrar o "Alvo".

mprudencio escreveu:Eu nao escrevi o codigo completo como havia falado nao vi sua planilha naquele momento.

Agora abri sua planilha mas nao entendi o que deve ser comparado com o que.

Realmente nao entendi seu processo.

O loop so deve se preocupar se a soma das variaveis a b c é maior do que o valor alvo??

No seu exemplo o alvo é 18.

Se a soma de a + b + c for 19 interrompe o codigo e grava em D12?

É isso??

Se eu entendi isso resolve:

Sub Combina()

Dim A As Byte
Dim B As Byte
Dim C As Byte
Dim QTD As Byte
Dim Alvo As Byte

QTD = 9
Alvo = Plan1.Range("D16").Value

For A = 0 To QTD
For B = 0 To QTD
For C = 0 To QTD

If A + B + C = Alvo Then
MsgBox "A combinação encontrada foi:" & Chr(13) & A & " " & B & " " & C
Exit Sub
End If

Next C
Next B
Next A

End Sub

Poxa, ainda não é o que eu preciso.

Esse comando apenas encontra uma combinação para "Alvo". Mas a combinação para o "Alvo" deve estar amarrada na célula D12, ou seja, o "maior" valor das combinações A+B+C deve ser igual a célula "Alvo".

Vou usar um exemplo.

De acordo com este último comando que vc passou, se eu colocar que o alvo é 18, a resposta do comando é 0 + 9 + 9.
Então se eu alinhar os valores 0 + 9 + 9, a soma da primeira coluna dá 18, mas a da última coluna dá 25. Portanto o maior valor é 25 e o que eu quero é que o maior valor seja 18.

Eu preciso de um comando que teste as combinações e que o "maior" valor da soma das 10 colunas seja igual ao "alvo".

mprudencio escreveu:Se eu entendi isso resolve:

Sub Combina()

Dim A As Byte
Dim B As Byte
Dim C As Byte
Dim QTD As Byte
Dim Alvo As Byte

QTD = 9
Alvo = Plan1.Range("D16").Value

For A = 0 To QTD
For B = 0 To QTD
For C = 0 To QTD

If A + B + C = Alvo Then
MsgBox "A combinação encontrada foi:" & Chr(13) & A & " " & B & " " & C
Exit Sub
End If

Next C
Next B
Next A

End Sub

Experimente:

Código: Selecionar todos

Sub Alvo()
 Dim a As Long, b As Long, c As Long
  Application.ScreenUpdating = False
  For a = 1 To 10
   For b = 1 To 10
    For c = 1 To 10
     Macro3
      If [D12] = [D16] Then Exit Sub
    Next c
   Macro2
   Next b
  Macro1
  Next a
 Application.ScreenUpdating = True
End Sub

dica - evite o uso do comando Select, simplifique as suas macros conforme abaixo.

Código: Selecionar todos

Sub Macro1()
 [O6].Cut
 [F6].Insert Shift:=xlToRight
End Sub

Sub Macro2()
 [O7].Cut
 [F7].Insert Shift:=xlToRight
End Sub

Sub Macro3()
 [O8].Cut
 [F8].Insert Shift:=xlToRight
End Sub

Teste a solução do oswaldo, se nao funcionar explica de novo que nao entendi.

Agora sim, ficou top a planilha!!

Muito obrigado Osvaldo!!

osvaldomp escreveu:Experimente:

Código: Selecionar todos

Sub Alvo()
 Dim a As Long, b As Long, c As Long
  Application.ScreenUpdating = False
  For a = 1 To 10
   For b = 1 To 10
    For c = 1 To 10
     Macro3
      If [D12] = [D16] Then Exit Sub
    Next c
   Macro2
   Next b
  Macro1
  Next a
 Application.ScreenUpdating = True
End Sub

dica - evite o uso do comando Select, simplifique as suas macros conforme abaixo.

Código: Selecionar todos

Sub Macro1()
 [O6].Cut
 [F6].Insert Shift:=xlToRight
End Sub

Sub Macro2()
 [O7].Cut
 [F7].Insert Shift:=xlToRight
End Sub

Sub Macro3()
 [O8].Cut
 [F8].Insert Shift:=xlToRight
End Sub

Olá Mprudencio,

O Osvaldo conseguiu resolver. Mesmo assim muito obrigado pela sua ajuda e paciência!!

mprudencio escreveu:Teste a solução do oswaldo, se nao funcionar explica de novo que nao entendi.

Desculpem a minha pergunta, mas Osvaldo é possível saber todas as combinações que dão o valor igual ao do ALVO? E escreve-las nas colunas, p.ex., Q, R e S

Obrigado e desculpem a minha intromissão no tópico.

JCabral escreveu:... é possível saber todas as combinações que dão o valor igual ao do ALVO? E escreve-las nas colunas, p.ex., Q, R e S

Olá, Cabral.
Rode o código abaixo. Sugiro que você altere as Macros 1 a 3, conforme eu sugeri antes, assim o tempo de execução será menor.
Lembrando que a combinação deve atender ao critério que é ser o maior valor de F10:O10.
Para ALVO=18, por exemplo, o código retorna a combinação 9, 6 e 3, variando a ordem, e essa combinação aparece múltiplas vezes pois ela pode ocorrer nas colunas de F a O.

Código: Selecionar todos

Sub AlvoV2()
 Dim a As Long, b As Long, c As Long, k As Long
  Application.ScreenUpdating = False
  For a = 1 To 10
   For b = 1 To 10
    For c = 1 To 10
     Macro3
      If [D12] = [D16] Then
       k = [F10:O10].Find([D12], LookIn:=xlValues).Column
       Cells(Rows.Count, "Q").End(3)(2).Resize(, 3).Value = Application.Transpose(Cells(6, k).Resize(3).Value)
      End If
    Next c
   Macro2
   Next b
  Macro1
  Next a
 Application.ScreenUpdating = True
 MsgBox "fim"
End Sub

Osvaldo seria interessante só ter valores únicos, mas julgo que iria tornar o código muito pesado em termos de calculo.

Valeu obrigado

JCabral escreveu:... seria interessante só ter valores únicos, ...

Explique o que você quer dizer com "valores únicos". Dê exemplos.

Osvaldo as combinações repetem-se, pex, a primeira combinação que respeita o critério é 9 6 3, e volta-se a repetir , assim como 3 9 6 ....etc, o que referia é que seria interessante só aparecerem casos únicos e não repetidos, para este caso são únicas as combinações 963, 639, 396, 963, 693 e 369

Olá, Cabral.
Uma alternativa para exibir sem repetição as combinações é utilizar a função Remover Duplicatas ao final do código.

Código: Selecionar todos

Range("Q2:S" & Cells(Rows.Count, 17).End(3).Row).RemoveDuplicates Columns:=Array(1, 2, 3)

brunopires0308 segue em anexo munha contribuição, espero que atenda as suas expectativas

Osvaldo, muito boa essa solução.

Contudo deixo aqui uma outra questão, esta solução (AlvoV2) só dá para alvos superiores a 18, certo? Para valores inferiores não mostra nada

JCabral escreveu: ... esta solução (AlvoV2) só dá para alvos superiores a 18, certo?

Se para o alvo abaixo do valor 18 não há combinações resultantes é porque não há combinações que atendam ao critério.

Guru do Excel e Power BI

Cadeado de Segredo

Cadeado de Segredo

Cadeado de Segredo

Re: Cadeado de Segredo

Cadeado de Segredo

Re: Cadeado de Segredo

Cadeado de Segredo

Re: Cadeado de Segredo

Re: Cadeado de Segredo

Cadeado de Segredo

Re: Cadeado de Segredo

Re: Cadeado de Segredo

Re: Cadeado de Segredo

Re: Cadeado de Segredo

Cadeado de Segredo

Re: Cadeado de Segredo

Cadeado de Segredo

Re: Cadeado de Segredo

Re: Cadeado de Segredo

Cadeado de Segredo

Re: Cadeado de Segredo