Notifications
Clear all

CONTADOR DE ACUMULAÇÃO DA MEGA SENA

6 Posts
3 Usuários
0 Reactions
1,728 Visualizações
(@jscopa10)
Posts: 0
New Member
Topic starter
 

.
https://www.sendspace.com/file/vkgfef
.
Como sempre esqueço de alterar o número de acumulações antes de tirar a foto para mandar no Grupo do Bolão, como aconteceu agora, gostaria de um VBA contador!! ... Ou seja, se eu aumentar o valor do próximo prêmio da célula K7 (acumulou), nesse caso o VBA aumenta (soma) 1 em P13 ... se o valor de K7 diminuir (sair o prêmio) ele zera P13 ... e assim sucessivamente!!
.
Explicações no arquivo postado!! ... Desde já, grato!!
.

 
Postado : 02/10/2019 6:56 pm
(@faraha)
Posts: 0
New Member
 

Boa noite JSCOPA!

Bom você precisa de um VBA contador? Bom... eu estou me formando em contabilidade e estou aprendendo visual basic, serve eu?

Desculpa pela piada.

Não sei se a seguinte rotina atende da forma que queria, mas creio que atenda a sua necessidade:

Segue o código da macro para executar o que desejas:

Sub testeContar()
Dim Z As Worksheet
Set Z = Sheets("Plan1")
If Z.Range("k7").Value > Z.Range("l7").Value Then
Z.Range("p13") = Z.Range("p13") + 1
End If
If Z.Range("k7").Value < Z.Range("l7").Value Then
Z.Range("p13") = 0
End If
Z.Range("l7") = Z.Range("k7").Value
End Sub

E segue o código para executar toda vez que o valor da célula "K7" altera, deve ser inserido no módulo da pasta "Plan1":

Private Sub Worksheet_Change(ByVal Target As Range)
        Application.EnableEvents = False
        If Not Intersect(Target, Range("K7")) Is Nothing Then
                Call testeContar
        End If
        Application.EnableEvents = True
End Sub

Basicamente utilizo a célula "L7" que está do lado da célula "K7" como "célula auxiliar" para verificar se o valor aumentou(acumulou) ou diminuiu(não acumulou), pode ser utilizado qualquer outra célula.

 
Postado : 02/10/2019 7:37 pm
(@jscopa10)
Posts: 0
New Member
Topic starter
 

.
Faraha, o código funciona ... mas gostaria de algo automático ... afinal o trabalho de mudar o número na mão e executar a macro é o mesmo k!! ... Além disso, assim como esqueço de mudar o número, posso esquecer de executar a macro!!
.

 
Postado : 03/10/2019 7:08 am
(@coutinho)
Posts: 0
New Member
 

.
Faraha, o código funciona ... mas gostaria de algo automático ... afinal o trabalho de mudar o número na mão e executar a macro é o mesmo k!! ... Além disso, assim como esqueço de mudar o número, posso esquecer de executar a macro!!.

JSCOPA10, tente assim, cole no modulo da aba que ira usar :

Dim sValor
Dim sValorNew
Dim i As Integer

Private Sub Worksheet_Change(ByVal Target As Range)
   
    Application.EnableEvents = False
        
        If Not Intersect(Target, Range("K7")) Is Nothing Then
            
            sValorNew = Target.Value
            
            If sValorNew > sValor Then
                    Range("P13") = Range("P13") + 1
                Else
                    Range("P13") = 0
            End If
            
        End If
        
    Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

    If Not Intersect(Target, Range("K7")) Is Nothing Then
        ReDim sValorAntigo(Target.Count)
        
        For i = 1 To Target.Count
            sValorAntigo(i) = Target(i)
            sValor = sValorAntigo(i)
        Next i
        
     End If
     
End Sub

[]s

Mauro Coutinho
Administrador

 
Postado : 03/10/2019 7:43 am
(@faraha)
Posts: 0
New Member
 

Bom dia JSCOPA e Coutinho!

@JSCOPA creio que eu não soube explicar direito como funciona.
A rotina do Amigo Coutinho é mais completa pois não usa "célula auxiliar".
Porém caso cole o código que demonstrei anteriormente, também é feito automaticamente a mudança dos valores não é necessário executar a macro, pois esta atrelada ao evento worksheet_change em caso de mudança do valor da célula "K7" apenas, assim como no exemplo do amigo Coutinho.

Segue exemplo de como ficaria o código no módulo da aba que quiser utilizar a rotina(aconselho o uso da rotina do amigo Coutinho por não utilizar "célula auxiliar"):

Private Sub Worksheet_Change(ByVal Target As Range)
        Application.EnableEvents = False
        If Not Intersect(Target, Range("K7")) Is Nothing Then
                Call testeContar
        End If
        Application.EnableEvents = True
End Sub
Sub testeContar()
If Range("k7").Value > Range("l7").Value Then
Range("p13") = Range("p13") + 1
End If
If Range("k7").Value < Range("l7").Value Then
Range("p13") = 0
End If
Range("l7") = Range("k7").Value
End Sub

 
Postado : 03/10/2019 7:59 am
(@jscopa10)
Posts: 0
New Member
Topic starter
 

.
Valeu Coutinho e FarahA !!! ... Os dois códigos funcionaram!! ... Mas fiquei com o do Coutinho por não ter coluna auxiliar!! ... Muito grato a todos!!!
.

 
Postado : 03/10/2019 5:53 pm