Combinaison 3chiffres loto

Le 16/02/2017 à 18:43

Bonjour tout le monde,

Je suis nouveau sur le faux rhum, je m’appelle greg, et j'ai un petit problème avec excel.

J'essaie de faire une fonction mais je n'y arrive pas.

J'ai essayé avec countif et autre mais j'arrive pas un résultat concluant.

Ce que je voudrais faire

C'est compter le nombre de fois qu'une même combinaison de 3 chiffres arrive dans un même tirage du loto.

Pour chaque tirage on a 5 chiffre, moi je voudrais savoir quelles combinaisons arrivent le plus souvent.

Et j'aimerais ressortir chaque combinaison sure une autre page avec le nombre de fois qu'elle est tombé à coté.

J'espère que c'est assez clair, si vous avez des questions n'hésitez pas,

Merci d'avance !

Greg

Le 16/02/2017 à 19:57

Bonsoir,

Pour chaque tirage de 5 nombres, il y a 10 combinaisons de 3. Tu les extrais et tu les comptes...

Et la prochaine fois, reviens avec un vrai fichier Excel... et du vrai rhum !

Le 16/02/2017 à 21:27

Bonsoir,

Merci pour la réponse,

En fait j'aimerais faire exactement comme sur ce site internet :

https://www.lotolabo.com/fr/loto/statistiques-des-quartets-de-numeros

On y vois le nombres de tirages où les quatre boules sont sorties ensemble.

Je mets le fichier excel aussi si ça peut aider.

Je ne sais pas si c'est réalisable.

Merci pour votre aide !

Greg

151nouveau-loto.xlsx (100.17 Ko)
Le 17/02/2017 à 08:48

Ce qui est bien c'est que dans ton tableau, on a les tirages du loto jusqu'au mois d'avril 2017 !!

Sinon, faut-il prendre en compte les numéros complémentaires ?

Le 17/02/2017 à 12:11

Bonjour,

Function TroisB(Tir As Range)
    Dim t5(5), c3b(9), i%, j%, k%, n%, cb$
    For i = 1 To Tir.Cells.Count
        t5(i) = Tir.Cells(i)
    Next i
    For i = 1 To 4
        For j = i + 1 To 5
            If t5(j) < t5(i) Then
                t5(0) = t5(j): t5(j) = t5(i): t5(i) = t5(0)
            End If
        Next j
    Next i
    For i = 1 To 3
        For j = i + 1 To 4
            For k = j + 1 To 5
                cb = t5(i) & "|" & t5(j) & "|" & t5(k)
                c3b(n) = cb: n = n + 1
            Next k
        Next j
    Next i
    TroisB = c3b
End Function

Sub FrqTroisB()
    Dim d As Object, Tcb(), k, n%, i%, j%
    Set d = CreateObject("Scripting.Dictionary")
    With Feuil1
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            k = TroisB(.Range("E" & i).Resize(, 5))
            For j = 0 To 9
                If d.exists(k(j)) Then
                    d(k(j)) = CInt(d(k(j))) + 1
                Else
                    d(k(j)) = 1
                End If
            Next j
        Next i
    End With
    n = 0
    ReDim Tcb(1 To d.Count, 1 To 4)
    For Each k In d.keys
        n = n + 1: Tcb(n, 1) = k: Tcb(n, 4) = CInt(d(k))
    Next k
    For i = 1 To UBound(Tcb, 1) - 1
        For j = i + 1 To UBound(Tcb, 1)
            If Tcb(j, 1) < Tcb(i, 1) Then
                k = Tcb(j, 1): n = Tcb(j, 4)
                Tcb(j, 1) = Tcb(i, 1): Tcb(j, 4) = Tcb(i, 4)
                Tcb(i, 1) = k: Tcb(i, 4) = n
            End If
        Next j
    Next i
    For i = 1 To UBound(Tcb, 1) - 1
        For j = i + 1 To UBound(Tcb, 1)
            If Tcb(j, 4) > Tcb(i, 4) Then
                k = Tcb(j, 1): n = Tcb(j, 4)
                Tcb(j, 1) = Tcb(i, 1): Tcb(j, 4) = Tcb(i, 4)
                Tcb(i, 1) = k: Tcb(i, 4) = n
            End If
        Next j
    Next i
    For i = 1 To UBound(Tcb, 1)
        k = Split(Tcb(i, 1), "|")
        For j = 1 To 3
            Tcb(i, j) = CInt(k(j - 1))
        Next j
    Next i
    With Feuil2
        .Range("A1").CurrentRegion.Offset(1).ClearContents
        .Range("A2").Resize(UBound(Tcb, 1), 4).Value = Tcb
        .Activate
    End With
End Sub

9347 combinaisons différentes parmi 13060 issues des tirages, à identifier, décompter, et trier. Cela prend un certain temps...

Etre patient donc !

Cordialement.

191excelnoob7-nouveau-loto.xlsm (316.53 Ko)
Le 17/02/2017 à 13:31

Bonjour,

une autre solution, ne prend pas en compte le numéro complémentaire.

Dim sol(1 To 3), dict As Object, a(1 To 5)
Sub aarg()
Set dict = CreateObject("scripting.dictionary")
dict.RemoveAll
With Sheets("nouveau_loto")
 For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
   For j = 1 To 5
    a(j) = .Cells(i, j + 4)
   Next j
   For j = 1 To 4
    For k = j + 1 To 5
     If a(j) > a(k) Then t = a(j): a(j) = a(k): a(k) = t
    Next k
   Next j
  compte
 Next i
End With
With Sheets("sheet1")
 .Cells.ClearContents
 .Cells(1, 1).Resize(dict.Count) = Application.Transpose(dict.keys)
 .Cells(1, 2).Resize(dict.Count) = Application.Transpose(dict.items)
 .Columns("A:B").Sort key1:=.Range("B1"), order1:=xlDescending, Header:=xlNo
End With
End Sub
Sub compte(Optional lvl = 1, Optional bi = 1)
For i = bi To 2 + lvl
 sol(lvl) = a(i)
 If lvl = 3 Then
  k = Join(sol(), "|")
  If dict.exists(k) Then dict.Item(k) = dict.Item(k) + 1 Else dict.Add k, 1
 Else
  compte lvl + 1, i + 1
 End If
Next i
End Sub
Le 18/02/2017 à 10:25
melch a écrit :

Ce qui est bien c'est que dans ton tableau, on a les tirages du loto jusqu'au mois d'avril 2017 !!

Sinon, faut-il prendre en compte les numéros complémentaires ?

Haha, moi aussi je me suis fait avoir, nan ça c'est la date de forclusion, la date jusqu’à laquelle tu peux retirer ton gain, après c'est wallouu.

Pour les complémentaires, je n'est pas besoin de les prendre en compte, juste les 5 boules.

Merci pour le message en tout cas !

MFerrand a écrit :

Bonjour,

Function TroisB(Tir As Range)
    Dim t5(5), c3b(9), i%, j%, k%, n%, cb$
    For i = 1 To Tir.Cells.Count
        t5(i) = Tir.Cells(i)
    Next i
    For i = 1 To 4
        For j = i + 1 To 5
            If t5(j) < t5(i) Then
                t5(0) = t5(j): t5(j) = t5(i): t5(i) = t5(0)
            End If
        Next j
    Next i
    For i = 1 To 3
        For j = i + 1 To 4
            For k = j + 1 To 5
                cb = t5(i) & "|" & t5(j) & "|" & t5(k)
                c3b(n) = cb: n = n + 1
            Next k
        Next j
    Next i
    TroisB = c3b
End Function

Sub FrqTroisB()
    Dim d As Object, Tcb(), k, n%, i%, j%
    Set d = CreateObject("Scripting.Dictionary")
    With Feuil1
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            k = TroisB(.Range("E" & i).Resize(, 5))
            For j = 0 To 9
                If d.exists(k(j)) Then
                    d(k(j)) = CInt(d(k(j))) + 1
                Else
                    d(k(j)) = 1
                End If
            Next j
        Next i
    End With
    n = 0
    ReDim Tcb(1 To d.Count, 1 To 4)
    For Each k In d.keys
        n = n + 1: Tcb(n, 1) = k: Tcb(n, 4) = CInt(d(k))
    Next k
    For i = 1 To UBound(Tcb, 1) - 1
        For j = i + 1 To UBound(Tcb, 1)
            If Tcb(j, 1) < Tcb(i, 1) Then
                k = Tcb(j, 1): n = Tcb(j, 4)
                Tcb(j, 1) = Tcb(i, 1): Tcb(j, 4) = Tcb(i, 4)
                Tcb(i, 1) = k: Tcb(i, 4) = n
            End If
        Next j
    Next i
    For i = 1 To UBound(Tcb, 1) - 1
        For j = i + 1 To UBound(Tcb, 1)
            If Tcb(j, 4) > Tcb(i, 4) Then
                k = Tcb(j, 1): n = Tcb(j, 4)
                Tcb(j, 1) = Tcb(i, 1): Tcb(j, 4) = Tcb(i, 4)
                Tcb(i, 1) = k: Tcb(i, 4) = n
            End If
        Next j
    Next i
    For i = 1 To UBound(Tcb, 1)
        k = Split(Tcb(i, 1), "|")
        For j = 1 To 3
            Tcb(i, j) = CInt(k(j - 1))
        Next j
    Next i
    With Feuil2
        .Range("A1").CurrentRegion.Offset(1).ClearContents
        .Range("A2").Resize(UBound(Tcb, 1), 4).Value = Tcb
        .Activate
    End With
End Sub

9347 combinaisons différentes parmi 13060 issues des tirages, à identifier, décompter, et trier. Cela prend un certain temps...

Etre patient donc !

Cordialement.

Ha oui, c'est carrément de la grosse formule ça, moi j'étais parti sur du countifs, là c'est pas le même level...

Merci en tout cas de la participation, ça fait plaisir ! je vais essayer ça !

h2so4 a écrit :

Bonjour,

une autre solution, ne prend pas en compte le numéro complémentaire.

Dim sol(1 To 3), dict As Object, a(1 To 5)
Sub aarg()
Set dict = CreateObject("scripting.dictionary")
dict.RemoveAll
With Sheets("nouveau_loto")
 For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
   For j = 1 To 5
    a(j) = .Cells(i, j + 4)
   Next j
   For j = 1 To 4
    For k = j + 1 To 5
     If a(j) > a(k) Then t = a(j): a(j) = a(k): a(k) = t
    Next k
   Next j
  compte
 Next i
End With
With Sheets("sheet1")
 .Cells.ClearContents
 .Cells(1, 1).Resize(dict.Count) = Application.Transpose(dict.keys)
 .Cells(1, 2).Resize(dict.Count) = Application.Transpose(dict.items)
 .Columns("A:B").Sort key1:=.Range("B1"), order1:=xlDescending, Header:=xlNo
End With
End Sub
Sub compte(Optional lvl = 1, Optional bi = 1)
For i = bi To 2 + lvl
 sol(lvl) = a(i)
 If lvl = 3 Then
  k = Join(sol(), "|")
  If dict.exists(k) Then dict.Item(k) = dict.Item(k) + 1 Else dict.Add k, 1
 Else
  compte lvl + 1, i + 1
 End If
Next i
End Sub

Merci pour le travail, c'est dingue !

Par contre je dois mettre ça ou dans excel?

Le 18/02/2017 à 14:08

Bonjour,

copier le code qui se trouve sur le forum, tout selectionner puis Ctrl-C

aller dans excel faire alt-F11 pour ouvrir VBA

faire ->insérer-> module

coller le code CTRL-V

revenir à excel alt-F11

la macro est maintenant disponible pour excel

faire alt-F8 pour executer la macro aargh

Rechercher des sujets similaires à "combinaison 3chiffres loto"