MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

2 participantes

    [Resolvido]Encontrar conjunto de Números

    Celso Roberto
    Celso Roberto
    VIP
    VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1071
    Registrado : 01/03/2014

    [Resolvido]Encontrar conjunto de Números Empty [Resolvido]Encontrar conjunto de Números

    Mensagem  Celso Roberto 22/1/2019, 20:50

    Boa tarde a todos...

    Uso este código criado pelo Dilson para um membro do fórum neste link

    maximoaccess.com/t19563-resolvidoloop-quantidade-de-registros-especificos-entre-campos#144662

    Funciona corretamento para o objetivo.

    Estou tentando adaptar para que a Variável Encontrar, encontre um conjunto de números mas não obtive sucesso

    Ex: Se meu campo Me!ConjNum contém apenas um número, ele percorre corretamente toda a tabela Resultados e me traz o número de ocorrências.

    Preciso que se meu campo Me!ConjNum for um conjunto de números Ex:(5,9,11), ele faça o mesmo procedimento e só registre uma ocorrência se na tabela Resultados exista este conjunto, isto é só contar uma ocorrência se existir os 3 elementos

    Nota: Na tabela resultados sempre vai existir 6 números e o meu campo Me!ConjNum pode variar de 1 a 6 números

    Agradeço toda a ajuda

    Abraços


    Código:
    Dim Rs As DAO.Recordset
    Dim i As Integer
    Dim Encontrar As Integer
    Dim Encontrado As Long
    Set Rs = CurrentDb.OpenRecordset("tblResultados")
    Encontrar = Me!ConjNum
    Encontrado = 0
    For i = 1 To 6
    Rs.MoveLast
    Rs.MoveFirst
    Do While Not Rs.EOF
      If Rs(("d" & i)) = Encontrar Then
            Encontrado = Encontrado + 1
      End If
    Rs.MoveNext
    Loop
    Next i
    Rs.Close
    If Encontrado > 1 Then
    MsgBox "Encontrado " _
          & Encontrado & " ocorrências."
    Else
    MsgBox "Encontrado " _
          & Encontrado & " ocorrências."
    End If
    End Sub


    .................................................................................


    Você fica satisfeito ao ter sua dúvida solucionada?.
    Quem te ajuda também fica quando você da o tópico por "Resolvido".
    Veja como neste Link: https://www.maximoaccess.com/t860-resolucao-de-topicos



    A Única coisa que sei é que ainda nada sei, Mas em breve Saberei.....
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8002
    Registrado : 05/11/2009

    [Resolvido]Encontrar conjunto de Números Empty Re: [Resolvido]Encontrar conjunto de Números

    Mensagem  Alexandre Neves 23/1/2019, 15:12

    Boa tarde,
    Não entendi bem como tem a tabela
    Disponibilize bd com dados significativos


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    Celso Roberto
    Celso Roberto
    VIP
    VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1071
    Registrado : 01/03/2014

    [Resolvido]Encontrar conjunto de Números Empty Re: [Resolvido]Encontrar conjunto de Números

    Mensagem  Celso Roberto 23/1/2019, 16:31

    Olá Alexandre Neves

    Obrigado pelo interesse em ajudar.

    No exemplo anexo se você digitar qualquer número entre 1 e 60 no campo Me!ConjNum e clicar no botão, ele vai contar em todos os registros da tabela resultados a quantidade de vezes que ele existe.

    O que preciso e digitar até 6 números diferentes separados por virgula ou qualquer outro delimitador e contar na tabela resultados quantas vezes este conjunto de números existe

    Ex:( 5,9,11) vai existir 4 vezes conforme abaixo

    Concurso Data
    1016  25/10/2008 5 9 11 20 25 60
    1077  27/05/2009 5 6 9 11 18 37
    1262  02/03/2011 5 7 8 9 11 39
    1276  20/04/2011 5 9 11 22 36 40

    Abraços


    Desculpe, faltou o arquivo

    Já editei
    Anexos
    [Resolvido]Encontrar conjunto de Números AttachmentEncontrarConjNumeros.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (356 Kb) Baixado 6 vez(es)


    .................................................................................


    Você fica satisfeito ao ter sua dúvida solucionada?.
    Quem te ajuda também fica quando você da o tópico por "Resolvido".
    Veja como neste Link: https://www.maximoaccess.com/t860-resolucao-de-topicos



    A Única coisa que sei é que ainda nada sei, Mas em breve Saberei.....
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8002
    Registrado : 05/11/2009

    [Resolvido]Encontrar conjunto de Números Empty Re: [Resolvido]Encontrar conjunto de Números

    Mensagem  Alexandre Neves 23/1/2019, 19:34

    Todo o código para o módulo
    Código:
    Option Compare Database
    Option Explicit

    Function NumerosCoincidentes(n1 As String, n2 As String, n3 As String, n4 As String, n5 As String, n6 As String, x1 As String, x2 As String, x3 As String, x4 As String, x5 As String, x6 As String) As Integer
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '  código criado por Alexandre Neves, do Fórum MaximoAccess  '
        '    utilize o código livremente mas mantenha os créditos    '
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim n1Coincidente As Boolean, n2Coincidente As Boolean, n3Coincidente As Boolean, n4Coincidente As Boolean, n5Coincidente As Boolean, n6Coincidente As Boolean
        If n1 = "" Then
            n1Coincidente = True
        Else
            If n1 = x1 Or n1 = x2 Or n1 = x3 Or n1 = x4 Or n1 = x5 Or n1 = x6 Then n1Coincidente = True
        End If
       
        If n2 = "" Then
            n2Coincidente = True
        Else
            If n2 = x1 Or n2 = x2 Or n2 = x3 Or n2 = x4 Or n2 = x5 Or n2 = x6 Then n2Coincidente = True
        End If
       
        If n3 = "" Then
            n3Coincidente = True
        Else
            If n3 = x1 Or n3 = x2 Or n3 = x3 Or n3 = x4 Or n3 = x5 Or n3 = x6 Then n3Coincidente = True
        End If
       
        If n4 = "" Then
            n4Coincidente = True
        Else
            If n4 = x1 Or n4 = x2 Or n4 = x3 Or n4 = x4 Or n4 = x5 Or n4 = x6 Then n4Coincidente = True
        End If
       
        If n5 = "" Then
            n5Coincidente = True
        Else
            If n5 = x1 Or n5 = x2 Or n5 = x3 Or n5 = x4 Or n5 = x5 Or n5 = x6 Then n5Coincidente = True
        End If
       
        If n6 = "" Then
            n6Coincidente = True
        Else
            If n6 = x1 Or n6 = x2 Or n6 = x3 Or n6 = x4 Or n6 = x5 Or n6 = x6 Then n6Coincidente = True
        End If
       
        If n1Coincidente And n2Coincidente And n3Coincidente And n4Coincidente And n5Coincidente And n6Coincidente Then NumerosCoincidentes = 1
    End Function

    Private Sub BtnContaComb_Click()
        Dim Rs As DAO.Recordset, I As Integer, Coincidentes As Integer
        Dim Texto As String, n1 As String, n2 As String, n3 As String, n4 As String, n5 As String, n6 As String
       
        Texto = Replace(Me!ConjNum, " ", "")
        Do
            If Texto = "" Then Exit Do
            If n1 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n1 = Texto
                    Texto = ""
                Else
                    n1 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n1) + 2)
                End If
            ElseIf n2 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n2 = Texto
                    Texto = ""
                Else
                    n2 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n2) + 2)
                End If
            ElseIf n3 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n3 = Texto
                    Texto = ""
                Else
                    n3 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n3) + 2)
                End If
            ElseIf n4 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n4 = Texto
                    Texto = ""
                Else
                    n4 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n4) + 2)
                End If
            ElseIf n5 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n5 = Texto
                    Texto = ""
                Else
                    n5 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n5) + 2)
                End If
            Else
                n6 = Texto
                Texto = ""
            End If
        Loop
       
        Set Rs = CurrentDb.OpenRecordset("tblResultados")
       
        Do While Not Rs.EOF
            Coincidentes = Coincidentes + NumerosCoincidentes(n1, n2, n3, n4, n5, n6, Rs("dezena1"), Rs("dezena2"), Rs("dezena3"), Rs("dezena4"), Rs("dezena5"), Rs("dezena6"))
            Rs.MoveNext
        Loop
        Me.Ocorrencias = Coincidentes
        Rs.Close
        If Coincidentes = 0 Then
            MsgBox "Não foram encontradas ocorrências."
        ElseIf Coincidentes = 1 Then
            MsgBox "Encontrada 1 ocorrência."
        Else
            MsgBox "Encontradas " & Coincidentes & " ocorrências."
        End If
    End Sub

    Private Sub btnFechar_Click()
    DoCmd.Close
    End Sub


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    Celso Roberto
    Celso Roberto
    VIP
    VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1071
    Registrado : 01/03/2014

    [Resolvido]Encontrar conjunto de Números Empty Re: [Resolvido]Encontrar conjunto de Números

    Mensagem  Celso Roberto 24/1/2019, 03:34

    Olá Alexandre Neves

    Mais uma vez agradeço a sua ajuda e te digo que o seu código funcionou na perfeição, mas preciso fazer uma alteração.

    como as combinações possíveis é gerada em um subformulário do tipo contínuo,  como posso adaptar seu código para executar o resultado da Ocorrência em cada linha do subformulário?

    Em cada linha do sub é uma combinação diferente, mas sempre com a mesma quantidade de elementos. Deixei uma coluna com os resultados que devem acontecer.

    Eu tentei algumas alterações, mas sem exito

    Segue o anexo modificado

    Abraços
    Anexos
    [Resolvido]Encontrar conjunto de Números AttachmentEncontrarConjNumeros.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (314 Kb) Baixado 6 vez(es)


    .................................................................................


    Você fica satisfeito ao ter sua dúvida solucionada?.
    Quem te ajuda também fica quando você da o tópico por "Resolvido".
    Veja como neste Link: https://www.maximoaccess.com/t860-resolucao-de-topicos



    A Única coisa que sei é que ainda nada sei, Mas em breve Saberei.....
    Celso Roberto
    Celso Roberto
    VIP
    VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1071
    Registrado : 01/03/2014

    [Resolvido]Encontrar conjunto de Números Empty Re: [Resolvido]Encontrar conjunto de Números

    Mensagem  Celso Roberto 28/1/2019, 18:51

    Olá a todos

    Resolvido alterando conforme abaixo

    Código:
    Option Compare Database
    Option Explicit

    Function NumerosCoincidentes(n1 As String, n2 As String, n3 As String, n4 As String, n5 As String, n6 As String, x1 As String, x2 As String, x3 As String, x4 As String, x5 As String, x6 As String) As Integer
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '   código criado por Alexandre Neves, do Fórum MaximoAccess   '
        '     utilize o código livremente mas mantenha os créditos     '
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim n1Coincidente As Boolean, n2Coincidente As Boolean, n3Coincidente As Boolean, n4Coincidente As Boolean, n5Coincidente As Boolean, n6Coincidente As Boolean
        If n1 = "" Then
            n1Coincidente = True
        Else
            If n1 = x1 Or n1 = x2 Or n1 = x3 Or n1 = x4 Or n1 = x5 Or n1 = x6 Then n1Coincidente = True
        End If
        
        If n2 = "" Then
            n2Coincidente = True
        Else
            If n2 = x1 Or n2 = x2 Or n2 = x3 Or n2 = x4 Or n2 = x5 Or n2 = x6 Then n2Coincidente = True
        End If
        
        If n3 = "" Then
            n3Coincidente = True
        Else
            If n3 = x1 Or n3 = x2 Or n3 = x3 Or n3 = x4 Or n3 = x5 Or n3 = x6 Then n3Coincidente = True
        End If
        
        If n4 = "" Then
            n4Coincidente = True
        Else
            If n4 = x1 Or n4 = x2 Or n4 = x3 Or n4 = x4 Or n4 = x5 Or n4 = x6 Then n4Coincidente = True
        End If
        
        If n5 = "" Then
            n5Coincidente = True
        Else
            If n5 = x1 Or n5 = x2 Or n5 = x3 Or n5 = x4 Or n5 = x5 Or n5 = x6 Then n5Coincidente = True
        End If
        
        If n6 = "" Then
            n6Coincidente = True
        Else
            If n6 = x1 Or n6 = x2 Or n6 = x3 Or n6 = x4 Or n6 = x5 Or n6 = x6 Then n6Coincidente = True
        End If
        
        If n1Coincidente And n2Coincidente And n3Coincidente And n4Coincidente And n5Coincidente And n6Coincidente Then NumerosCoincidentes = 1
    End Function

    Private Function ContaComb()

    Dim Rs As DAO.Recordset, I As Integer, Coincidentes As Integer
        Dim Texto As String, n1 As String, n2 As String, n3 As String, n4 As String, n5 As String, n6 As String
        
        Texto = Replace(Replace(Me!frmCombinacoesGeradasSubForm!ConjNum, " ", ""), "-", ",")
        
        Do
            If Texto = "" Then Exit Do
            If n1 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n1 = Texto
                    Texto = ""
                Else
                    n1 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n1) + 2)
                End If
            ElseIf n2 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n2 = Texto
                    Texto = ""
                Else
                    n2 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n2) + 2)
                End If
            ElseIf n3 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n3 = Texto
                    Texto = ""
                Else
                    n3 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n3) + 2)
                End If
            ElseIf n4 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n4 = Texto
                    Texto = ""
                Else
                    n4 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n4) + 2)
                End If
            ElseIf n5 = "" Then
                If InStr(1, Texto, ",") = 0 Then
                    n5 = Texto
                    Texto = ""
                Else
                    n5 = Mid(Texto, 1, InStr(1, Texto, ",") - 1)
                    Texto = Mid(Texto, Len(n5) + 2)
                End If
            Else
                n6 = Texto
                Texto = ""
            End If
        Loop
        
        Set Rs = CurrentDb.OpenRecordset("tblResultados")
        
        Do While Not Rs.EOF
            Coincidentes = Coincidentes + NumerosCoincidentes(n1, n2, n3, n4, n5, n6, Rs("dezena1"), Rs("dezena2"), Rs("dezena3"), Rs("dezena4"), Rs("dezena5"), Rs("dezena6"))
            Rs.MoveNext
        Loop
        Me!frmCombinacoesGeradasSubForm!Ocorrencias = Coincidentes
        Rs.Close
    '    If Coincidentes = 0 Then
    '        MsgBox "Não foram encontradas ocorrências."
    '    ElseIf Coincidentes = 1 Then
    '        MsgBox "Encontrada 1 ocorrência."
    '    Else
    '        MsgBox "Encontradas " & Coincidentes & " ocorrências."
    '    End If
        Coincidentes = 0
    End Function


    No evento ao clicar do botão

    Código:
    Private Sub BtnContaComb_Click()
       Dim rst As Recordset
       
       Set rst = frmCombinacoesGeradasSubForm.Form.Recordset
       rst.MoveFirst

       Do While Not rst.EOF
         
       Call ContaComb
       rst.MoveNext
       Loop
    End Sub


    Obrigado a todos e em especial ao Alexandre Neves pela criação do código


    Abraços


    .................................................................................


    Você fica satisfeito ao ter sua dúvida solucionada?.
    Quem te ajuda também fica quando você da o tópico por "Resolvido".
    Veja como neste Link: https://www.maximoaccess.com/t860-resolucao-de-topicos



    A Única coisa que sei é que ainda nada sei, Mas em breve Saberei.....

      Data/hora atual: 1/8/2021, 12:49