Este fórum está sendo desativado

[brunopires0308]

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.

[mprudencio]

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

[brunopires0308]

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

[mprudencio]

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??

[brunopires0308]

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".

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??

[mprudencio]

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

[brunopires0308]

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".

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

[osvaldomp]

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

[mprudencio]

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

[brunopires0308]

Agora sim, ficou top a planilha!!

Muito obrigado Osvaldo!!

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

[brunopires0308]

Olá Mprudencio,

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

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

[JCabral]

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.

[osvaldomp]

... é 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

[JCabral]

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

Valeu obrigado

[osvaldomp]

... seria interessante só ter valores únicos, ...

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

[JCabral]

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

[osvaldomp]

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)

[kiko]

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

[JCabral]

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

[osvaldomp]

... 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.