Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por brunopires0308 29 Nov 2018 às 17:09
Membro Novato
Mensagens: 6
Reputação: 0
#38872
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.
Apenas usuários registrados podem ver ou baixar anexos.
Por mprudencio 29 Nov 2018 às 22:29
Membro 2 Estrelas
Mensagens: 129
Reputação: 39
#38886
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
Por mprudencio 01 Dez 2018 às 23:31
Membro 2 Estrelas
Mensagens: 129
Reputação: 39
#38959
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??
Por brunopires0308 03 Dez 2018 às 09:32
Membro Novato
Mensagens: 6
Reputação: 0
#38969
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??
Por mprudencio 03 Dez 2018 às 20:04
Membro 2 Estrelas
Mensagens: 129
Reputação: 39
#39012
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
Por brunopires0308 04 Dez 2018 às 09:50
Membro Novato
Mensagens: 6
Reputação: 0
#39026
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
Por osvaldomp 04 Dez 2018 às 17:32
Membro 5 Estrelas
Mensagens: 894
Reputação: 442
#39039
Experimente:
Código: Selecionar todosSub 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 todosSub 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
Por mprudencio 04 Dez 2018 às 20:21
Membro 2 Estrelas
Mensagens: 129
Reputação: 39
#39043
Teste a solução do oswaldo, se nao funcionar explica de novo que nao entendi.
Por brunopires0308 05 Dez 2018 às 11:46
Membro Novato
Mensagens: 6
Reputação: 0
#39062
Agora sim, ficou top a planilha!!

Muito obrigado Osvaldo!!

osvaldomp escreveu:Experimente:
Código: Selecionar todosSub 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 todosSub 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
Por brunopires0308 05 Dez 2018 às 11:48
Membro Novato
Mensagens: 6
Reputação: 0
#39063
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.
Por JCabral 05 Dez 2018 às 12:18
Membro 3 Estrelas
Mensagens: 268
Reputação: 37
#39064
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.
Por osvaldomp 05 Dez 2018 às 17:29
Membro 5 Estrelas
Mensagens: 894
Reputação: 442
#39071
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 todosSub 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

Por JCabral 05 Dez 2018 às 22:43
Membro 3 Estrelas
Mensagens: 268
Reputação: 37
#39078
Osvaldo seria interessante só ter valores únicos, mas julgo que iria tornar o código muito pesado em termos de calculo.

Valeu obrigado
Por osvaldomp 06 Dez 2018 às 00:59
Membro 5 Estrelas
Mensagens: 894
Reputação: 442
#39084
JCabral escreveu:... seria interessante só ter valores únicos, ...


Explique o que você quer dizer com "valores únicos". Dê exemplos.
Por JCabral 06 Dez 2018 às 22:51
Membro 3 Estrelas
Mensagens: 268
Reputação: 37
#39117
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
Por osvaldomp 07 Dez 2018 às 11:02
Membro 5 Estrelas
Mensagens: 894
Reputação: 442
#39127
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 todosRange("Q2:S" & Cells(Rows.Count, 17).End(3).Row).RemoveDuplicates Columns:=Array(1, 2, 3)
Por kiko 07 Dez 2018 às 12:12
Membro 1 Estrela
Mensagens: 26
Reputação: 9
#39136
brunopires0308 segue em anexo munha contribuição, espero que atenda as suas expectativas
Apenas usuários registrados podem ver ou baixar anexos.
Por JCabral 07 Dez 2018 às 16:32
Membro 3 Estrelas
Mensagens: 268
Reputação: 37
#39147
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
Por osvaldomp 07 Dez 2018 às 20:14
Membro 5 Estrelas
Mensagens: 894
Reputação: 442
#39150
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. ;) :geek: