Notifications
Clear all

Refazer calculos até atingir resultado ou apertar botão

10 Posts
3 Usuários
0 Reactions
959 Visualizações
(@wander2017)
Posts: 0
New Member
Topic starter
 

Bom dia pessoal!!! Estou com um problema na seguinte macro:

Sub GerarNumerosAleatoriosSemRepeticao()
02	Dim i                           As Integer
03	Dim j                           As Integer
04	Dim bRandomOk                   As Boolean
05	Dim valor_aleatorio             As Integer
06	Dim valor_maior                 As Integer
07	Dim total_numeros_gerados       As Integer
08	Dim total_numeros_para_gerar    As Integer
09	Dim iControleGerar              As Integer
10	Dim iColunaCelula               As Integer
11	 
12	    valor_maior = 60    'Informe o maior número que poderá ser gerado
13	    total_numeros_para_gerar = 20      'Informe a quantidade de números aleatórios que deseja gerar
14	    total_numeros_gerados = 0
15	    iLinhaCelulaInicial = 2     'Informe a linha da primeira célula que será escrito o número
16	    iColunaCelula = 2   'Informe a coluna. Exemplo: Coluna B = 2
17	    iControleGerar = total_numeros_para_gerar + iLinhaCelulaInicial - 1
18	 
19	    'Gera quantos números forem indicados na variável 'total_numeros_gerados'
20	    For i = iLinhaCelulaInicial To iControleGerar
21	        total_numeros_gerados = total_numeros_gerados + 1
22	 
23	        'Fica executando a geração de um novo número enquanto houver duplicidade
24	        Do
25	            'Utilize a condição abaixo para verificar se ainda existem números possíveis a serem gerados
26	            'Porque se i for maior que o valor limite, significa que todos os números já saíram. Então, sai do loop
27	            If valor_maior < total_numeros_gerados Then
28	                valor_aleatorio = 0
29	                bRandomOk = True
30	                Exit Do
31	            End If
32	 
33	            'Gera um novo número
34	            Randomize   'Sempre utilize esta função antes de chamar Rnd
35	            valor_aleatorio = Int((valor_maior * Rnd) + 1)
36	            bRandomOk = True
37	 
38	            'Verifica se já saiu este número
39	            For j = iLinhaCelulaInicial To i
40	                If Cells(j, iColunaCelula).Value = valor_aleatorio Then
41	                    bRandomOk = False
42	                    Exit For
43	                End If
44	            Next j
45	 
46	        Loop While bRandomOk = False
47	 
48	        'Escreve o número na célula
49	        Cells(i, iColunaCelula).Value = valor_aleatorio
50	    Next i
51	 
52	    MsgBox "valor encontrado", vbInformation
53	 
54	End Sub

Ela funciona mais ou menos como eu gostaria, mas não estou conseguindo fazer ela gerar estes números até uma determinada célula ( efetua a soma dos números gerados) do Excel atingir valor igual ou maior da outra célula (determinado por mim) ou ainda reiniciar geração de novos números se eu acionar um botão que coloquei na planilha.
Alguém pode me ajudar a resolver isso?

 
Postado : 17/01/2017 6:59 am
(@mprudencio)
Posts: 0
New Member
 

Em resumo o codigo faz o que ou deveria fazer o que?

Qto as limitações que vc precisa acho que uns ifs bem colocados resolveria por exemplo:

Vc pode usar algo assim apos a soma

if Valor da soma >= que valor indicado por vc then exit sub

ou seja qdo a soma atingir o valor indicado por vc ela para de executar o codigo.

Existem outras maneira de fazer isso mas no seu caso essa é a mais simples.

 
Postado : 17/01/2017 7:50 am
(@wander2017)
Posts: 0
New Member
Topic starter
 

Então não consigo fazer ela gerar uma nova sequencia de números sozinha, tenho que ficar rodando manualmente, gostaria que ela rodasse uma nova sequencia de números quando por exemplo na planilha1 o valor da célula C3 ( que é a soma dos números gerados pela macro ) fosse igual ou maior que o valor da célula C2 que é colocado manualmente, quando este valor é atingido ela para de gerar nova sequencia de números e só retorna ao apertar o botão, eu não consegui montar esta macro de jeito nenhum.
Será que alguém consegue montar isso?
É uma planilha para teste de um leitor de código, e eu não conheço quase nada de excel minha área de atuação é automação de máquinas e necessito que o leitor fique lendo este código até atingir o valor, basicamente é isso, eu não sei como fazer isso, tudo o que está ai até agora fui pegando na net e montando, gostaria de saber se alguém pode me ajudar a montar isso?

 
Postado : 17/01/2017 9:36 am
(@mprudencio)
Posts: 0
New Member
 

Deixa eu ver se entendi vc quer que o codigo rode infinitamente e reinicie, ou seja limpe toda a informação da coluna B e começe registrar novamente ate atingir determinado valor?

É isso?

 
Postado : 17/01/2017 10:17 am
(@wander2017)
Posts: 0
New Member
Topic starter
 

Isso o código vai rodar infinitamente limpando como você disse a coluna B e gerando um novo código, até atingir um valor na por exemplo célula C3 que seja igual ou mair que o valor da célula C2, o valor de C2 é colocado manualmente e o valor de C3 é a somatória dos valores gerados na coluna D pela planilha e não pelo código, ai ela para de gerar um novo valor na coluna B até apertar um botão de reiniciar, caso este valor nunca seja atingido tenho que ter uma forma de parar, pode ser pro um outro botão ou um contador sei lá de 100.000.000 de códigos ai ela para, e fica aguardando apertar o botão.
Não sei se consegui explicar direito.

 
Postado : 17/01/2017 11:49 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Atribua esse botão pra interromper para essa sub "Interromper()"
E rode a macro.
Agora é só fazer o que quer que faça

Dim abortar As Boolean

Sub GerarNumerosAleatoriosSemRepeticao()
Dim i                           As Long
Dim j                           As Long
Dim bRandomOk                   As Boolean
Dim valor_aleatorio             As Long
Dim valor_maior                 As Long
Dim total_numeros_gerados       As Long
Dim total_numeros_para_gerar    As Long
Dim iControleGerar              As Long
Dim iColunaCelula               As Long

    Do
    Range("B2:B21").ClearContents

    valor_maior = 60    'Informe o maior número que poderá ser gerado
    total_numeros_para_gerar = 20      'Informe a quantidade de números aleatórios que deseja gerar
    total_numeros_gerados = 0
    iLinhaCelulaInicial = 2     'Informe a linha da primeira célula que será escrito o número
    iColunaCelula = 2   'Informe a coluna. Exemplo: Coluna B = 2
    iControleGerar = total_numeros_para_gerar + iLinhaCelulaInicial - 1
    
    'Gera quantos números forem indicados na variável 'total_numeros_gerados'
        For i = iLinhaCelulaInicial To iControleGerar
            total_numeros_gerados = total_numeros_gerados + 1
        
            'Fica executando a geração de um novo número enquanto houver duplicidade
            Do
                'Utilize a condição abaixo para verificar se ainda existem números possíveis a serem gerados
                    'Porque se i for maior que o valor limite, significa que todos os números já saíram. Então, sai do loop
                If valor_maior < total_numeros_gerados Then
                    valor_aleatorio = 0
                    bRandomOk = True
                    Exit Do
                End If
        
                'Gera um novo número
                Randomize   'Sempre utilize esta função antes de chamar Rnd
                valor_aleatorio = Int((valor_maior * Rnd) + 1)
                bRandomOk = True
        
                'Verifica se já saiu este número
                For j = iLinhaCelulaInicial To i
                    If Cells(j, iColunaCelula).Value = valor_aleatorio Then
                        bRandomOk = False
                        Exit For
                    End If
                Next j
        
            Loop While bRandomOk = False
        
            'Escreve o número na célula
            Cells(i, iColunaCelula).Value = valor_aleatorio
        Next i
        
        If Range("C3").Value >= Range("C2").Value Then Exit Do
        DoEvents
        If abortar = True Then abortar = False: GoTo abortando
        
    Loop

    MsgBox "valor encontrado", vbInformation
    Exit Sub
abortando:
    MsgBox "operação abortada", vbInformation

End Sub

Sub Interromper()
    abortar = True
End Sub

Qualquer coisa da o grito.
Abraço

 
Postado : 17/01/2017 12:16 pm
(@wander2017)
Posts: 0
New Member
Topic starter
 

Muito obrigado está funcionando exatamente como eu queria.

 
Postado : 17/01/2017 1:01 pm
(@wander2017)
Posts: 0
New Member
Topic starter
 

Pessoal a macro ficou tão boa que o meu leitor não consegue ler os códigos, a geração está muito rápida, tem como fazer ela demorar um pouco mais, coisa de 1 segundo ou menos?

 
Postado : 17/01/2017 2:46 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

:lol: :lol: :lol:

Tenta colocar isso logo após o "Do" (brm no início)

Application.Wait TimeSerial(hour(now()), minute(now()), second(now()) + 1)

Qualquer coisa da o grito.
Abraço

 
Postado : 17/01/2017 3:45 pm
(@wander2017)
Posts: 0
New Member
Topic starter
 

Bernardo, muito, mais muito obrigado mesmo, ficou perfeita,não tenho como agradecer.
Já estou conseguindo fazer os testes dos leitores e deu tudo certo.

 
Postado : 19/01/2017 2:24 pm