MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    Sorteio de Jogos Futebol

    Compartilhe

    fabioavila
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 163
    Registrado : 22/03/2011

    Sorteio de Jogos Futebol

    Mensagem  fabioavila em 23/10/2017, 02:09

    Ola amigos,

    Estou com um bd que faz sorteio de jogos de futebol.. o codigo atual faz esse sorteio mas gostaria de fazer uma modificação pois hj ele faz o sorteio de todos os jogos da equipe x na tela na sequencia ex: se tiver 4 times

    PALMEIRAS
    SANTOS
    VASCO
    CRUZEIRO

    Fica assim na tabela:

    1 PALMEIRAS X SANTOS
    2 PALMEIRAS X VASCO
    3 PALMEIRAS X CRUZEIRO
    4 SANTOS X PALMEIRAS
    5 SANTOS X VASCO
    6 SANTOS X CRUZEIRO
    7 VASCO X PALMEIRAS
    8 VASCO X SANTOS
    9VASCO CRUZEIRO

    E assim por diante mas preciso que ele ficasse na ordem ex:

    1 PALMEIRAS X SANTOS
    2 VASCO X CRUZEIRO
    3 SANTOS X VASCO
    4 CRUZEIRO X PALMEIRAS

    E assim por diante.. meu código é o segunte:

    Código:
    Private Sub Sorteio_Click()

    If MsgBox("Confirmar Sorteio ? ", vbYesNo + vbQuestion, "Gestão de Futebol") = vbYes Then

    Dim Rst1 As DAO.Recordset, Rst2 As DAO.Recordset

    CurrentDb.Execute "DELETE * FROM Partidas;"
    Set Rst1 = CurrentDb.OpenRecordset("SELECT Equipe FROM Equipes;")
    Set Rst2 = CurrentDb.OpenRecordset("SELECT Equipe FROM Equipes;")
    Do While Not Rst1.EOF
    Rst2.MoveFirst
    Do While Not Rst2.EOF
    If Rst1(0) <> Rst2(0) Then CurrentDb.Execute "INSERT INTO Partidas(Visitado,Visitante) VALUES ('" & Rst1(0) & "','" & Rst2(0) & "');"
    Rst2.MoveNext
    Loop
    Rst1.MoveNext
    Loop
    Set Rst1 = Nothing: Set Rst2 = Nothing
    MsgBox "Sorteio Terminado.", vbQuestion, "Gestão de Futebol"
    Call Comando33_Click
    End If
    End Sub
    avatar
    CassioFabre
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 728
    Registrado : 18/01/2013

    Re: Sorteio de Jogos Futebol

    Mensagem  CassioFabre em 23/10/2017, 12:37

    Bom dia,

    Faça o sorteio através de rodadas. Na tabela onde grava o jogos, adicione um campo "rodada" e la voce preencha com cada rodada. E no loop, faça com que o código verifique se o time1 ou o time2 já está presente na tabela para a rodada em questão. Caso sim, faça-o pular o loop e verifique até que caia um jogo que não esteja cadastrado para a rodada.

    -------------------------------
    EDIT

    fiz um pequeno modelo aqui só com 4 times e apenas turno, sem returno. Só pra exemplificar o que quis dizer. Abra o formSorteio e veja os jogos já cadastrados. Depois clique em limpar e faça um novo sorteio. Os jogos são sorteados de forma aleatória. Um time não jogará nunca na mesma rodada e dois jogos nao aconterão em rodadas distintas. Caso queira fazer mais jogos, basta acrescentar times na tblTimes e o código já fará tudo automaticamente, porém só funciona para número par de times.

    Código:
        If MsgBox("Confirma o sorteio?", vbQuestion + vbYesNo, "Sorteio") = vbNo Then Exit Sub
       
        Dim qntRodadas As Integer
        Dim time1, time2 As Integer
        Dim nomeTime1, nomeTime2 As String
        Dim booRepeat As Boolean
        Dim j As Integer
       
        Set db = CurrentDb
        Set rs = db.OpenRecordset("SELECT COUNT(codigo) as c FROM tblTimes")
        Set rs1 = db.OpenRecordset("tblJogos")
       
        qntRodadas = rs!c - 1 'estou fazendo aqui apenas turno, sem returno
        j = 1

        For i = 1 To qntRodadas
            For j = 1 To (rs!c / 2) Step 0
                booRepeat = True
           
                Do While booRepeat = True
                    Randomize
                    time1 = Int(Rnd() * 4) + 1
                   
                    Randomize
                    time2 = Int(Rnd() * 4) + 1
                   
                    If time1 <> time2 Then
                        Dim str, st As String
                       
                        str = "SELECT COUNT(codigo) as c FROM tblJogos WHERE (codigotime1 = " & time1 & " or codigotime1 = " & time2 & " "
                        str = str & "Or codigotime2 = " & time1 & " Or codigotime2 = " & time2 & ") And rodada = " & i & ""
                       
                        st = "SELECT COUNT(codigo) as c FROM tblJogos WHERE (codigotime1 = " & time1 & " and codigotime2 = " & time2 & ") or "
                        st = st & "(codigotime1 = " & time2 & " and codigotime2 = " & time1 & ")"
                       
                        Dim r, s As Recordset
                       
                        Set r = db.OpenRecordset(str)
                        Set s = db.OpenRecordset(st)
                       
                        If r!c = 0 And s!c = 0 Then
                            booRepeat = False
                        End If
                       
                        r.Close
                    End If
                Loop
               
                Dim rsTimes As Recordset
                Set rsTimes = db.OpenRecordset("SELECT * FROM tblTimes WHERE codigo = " & time1 & "")
               
                nomeTime1 = rsTimes!nometime
               
                rsTimes.Close
               
                Set rsTimes = db.OpenRecordset("SELECT * FROM tblTimes WHERE codigo = " & time2 & "")
                nomeTime2 = rsTimes!nometime
               
                rsTimes.Close
               
                rs1.AddNew
                    rs1("rodada") = i
                    rs1("codigotime1") = time1
                    rs1("time1") = nomeTime1
                    rs1("codigotime2") = time2
                    rs1("time2") = nomeTime2
                rs1.Update
               
                j = j + 1
            Next
       
            j = 1
        Next i
       
        MsgBox "Sorteio realizado com sucesso!", vbInformation, "Sorteio"
        cbxJogos.Requery

    Abraço.
    Anexos
    sorteio.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (154 Kb) Baixado 28 vez(es)


    .................................................................................
    Só não tem código pra morte!
    avatar
    bigfill
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 343
    Registrado : 27/03/2015

    Re: Sorteio de Jogos Futebol

    Mensagem  bigfill em 24/10/2017, 17:22

    Boa tarde CassioFabre!

    Muito bacana este seu modelo, ha algum tempo estava querendo desenvolver um sistema para geração de campeonatos de vídeo games (FIFA e/ou PES), mais devido ao tempo não levei a frente.
    Mais este seu modelo me depertou o desejo de terminar este meu projeto, porem ao efetuar um teste de sorteio contendo os 20 times do brasileirão 2017, o access demorou 4 minutos para montar os 2 primeiro jogo.  Sad

    Ao efetuar um teste contendo uma quantidade de times maior travou ai também ?

    desde de já agradeço.
    avatar
    CassioFabre
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 728
    Registrado : 18/01/2013

    Re: Sorteio de Jogos Futebol

    Mensagem  CassioFabre em 24/10/2017, 17:55

    Boa tarde,

    Como eu fiz de uma meneira que o access sorteie aleatoriamente os times, quanto maior a quantidade de times mais tempo vai demorar. O mais correto seria criar algum tipo de criterio pra ele resetar. Por exemplo, voce pode criar uma variável que armazerá o código dos times já cadastrados naquela rodada, caso a função rnd() retorne um valor já cadastrado, voce faz com que ela nao aceite esse valor e faça um novo sorteio. Então, quando achar dois times que ainda nao foram cadastrados naquela, faça o código verificar se aquele jogo em questão já não foi cadastrado numa rodada anterior (isso este modelinho que passei já faz) e caso verdadeiro, grave o jogo na tabela, caso falso, faça com que sorteie novamente.

    É facil ver que esse processo vai ser cada vez mais demorado se voce inserir cada vez mais times no sorteio. Isso porque, da forma que fiz, o access nao consegue excluir "do saco" os times já cadastrados. Porque a função rnd() sorteia sempre os mesmo valores. Então a probabilidade de um time ja sorteado cair é basicamente a mesma em todas as rotações.

    Pesando aqui agora, talvez uma alternativa seria criar um campo booleano na tabela e ir marcando cada vez que o time seja incluído na rodada, gravar os códigos dos times restantes num vetor e fazer o access sortear os times dentro desse vetor. E o restante das verificações fique normal (com o adendo de caso o jogo "passar" na verificação, não esquecer de marcar o campo booleano para os dois times restantes). Acredito que diminuiria consideravelmente o tempo de sorteio e também não cairia no problema do loop infinito.

    Tenta aí e retorne.

    Abraço.


    .................................................................................
    Só não tem código pra morte!
    avatar
    roberval
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Anónimo
    Mensagens : 85
    Registrado : 17/05/2015

    Re: Sorteio de Jogos Futebol

    Mensagem  roberval em 24/10/2017, 18:40

    Eae Very Happy

    Fiz um pequeno sisteminha para organizar sem repetir, não sei se é o jeito correto, mas acho que serve, bom, ele está bem por cima, não ta salvando no banco nem nada... Segue anexo e o código

    Código:

        Dim rs As DAO.Recordset
        Dim times As Variant
        Dim sorteio As String, sequencia As String
        Dim numTimes As Integer
        Set rs = CurrentDb.OpenRecordset("Times")
        numTimes = rs.RecordCount
        Me.result.Caption = ""
        If numTimes > 0 Then
            For i = 1 To numTimes
                For x = 1 To numTimes - (i - 1)
                    sequencia = sequencia & rs("Time") & IIf(x = (numTimes - (i - 1)), "", ", ")
                Next
                sequencia = sequencia & vbCrLf
                rs.MoveNext
            Next
            times = Split(sequencia, vbCrLf)
            For i = 0 To UBound(times) - 1
                For x = (i + 1) To UBound(Split(times(i), ", ")) + i
                     Me.result.Caption = Me.result.Caption & Split(times(i), ", ")(0) & " - " & Split(times(x), ", ")(0) & vbCrLf
                Next
            Next
        End If

    Aqui tem uma tabela com o nome "Times", la tem o campo "Time" <--- É onde estão os times

    ---------------------------------------------------
    EDIT

    Se você quiser colocar mais times, mude o local onde vai sair os resultados (de rótulo para caixa de texto), pois vai dar um erro falando que "A configuração desta propriedade está muito longa"
    Anexos
    Times.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (156 Kb) Baixado 17 vez(es)


    .................................................................................
    [Você precisa estar registrado e conectado para ver esta imagem.]      Juro que eu sou legal     [Você precisa estar registrado e conectado para ver esta imagem.]
    avatar
    CassioFabre
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 728
    Registrado : 18/01/2013

    Re: Sorteio de Jogos Futebol

    Mensagem  CassioFabre em 24/10/2017, 19:21

    Boa tarde,

    Show, roberval! Mas a minha ideia é um pouco mais elaborada, pois no seu caso nao separa os jogos por rodada, faz o mesmo do amigo que abriu o tópico. O mais complicado é fazer os jogos nao repetirem à medida que as rodadas vão passando. Mas se fizer algo como falei acima, acredito que de certo.

    Abraço.


    .................................................................................
    Só não tem código pra morte!

    fabioavila
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 163
    Registrado : 22/03/2011

    Re: Sorteio de Jogos Futebol

    Mensagem  fabioavila em 24/10/2017, 23:11

    Olá Cassio

    Ficou show de bola só a questão de ter mais de 4 equipes para ele gerar o sorteio e ficar completo..

    Obrigado.

    fabioavila
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 163
    Registrado : 22/03/2011

    Re: Sorteio de Jogos Futebol

    Mensagem  fabioavila em 26/10/2017, 20:46

    Alguém tem alguma idéia de como conseguir incluir mais Times sem travar ?

    Obrigado
    avatar
    CassioFabre
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 728
    Registrado : 18/01/2013

    Re: Sorteio de Jogos Futebol

    Mensagem  CassioFabre em 14/3/2018, 13:05

    Bom dia,

    De uma olhada no exemplo da mensagem nº 9 do tópico [Você precisa estar registrado e conectado para ver este link.] veja o código que montei com o botão. Talvez a lógica resolva o problema da inclusão de muitos itens.

    Abraço.


    .................................................................................
    Só não tem código pra morte!

      Data/hora atual: 18/11/2018, 19:12