3 chiffres qui sorte le plus souvent ensemble sur 20 numéro

Bonjour

je suis pas très bon avec exel

jai déja une formule qui va trouvé le 3 chiffre qui sorte le plus souvent ensemble sur 5 numéros

je voudrais la modifier pour quelle sorte les 3 chiffre qui sorte le plus souvent ensemble mais sur 20 numéros

et si ses possible un autre qui sort 4 sur 20 aussi

jai essayer mais je trouve pas comment faire

voici la macro

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

voici le fichier

Bonjour,

peux-tu mettre un autre fichier, car dans celui posté il n'y a toujours que 5 boules tirées au sort ... ou alors je ne comprends pas le sujet !

Bonjour

il faut que la macro sorte les 3 chiffres qui sorte le plus souvant ensemble sur 20 numéros

ex 123 et le numbre de fois sorti

25 29 44

41 53 70

Ach, je me disais aussi ... avec ce fichier on va pouvoir travailler ...

Voici pour 3

fichier en cours de correction

Voici pour 3 parmi 20

Pour 4 il faudra retravailler la solution pour être plus rapide !

Bonjour à tous !

Bienvenue sur le site christian19

Voici un fichier qui calcule 7000 tirages en moins de 3 minutes et qui te donne le numéro

du tirage auquel la combinaison est sortie. Tu pourras modifier à ta guise avec les numéros

réels des tirages du keno ou Banco.

Bonne journée !

merci beaucoup

pour les 4 chiffres si tu trouve une solution

je suis intéressé

sinon merci beaucoup

A qui tu t'adresses ? car j'ai levé le pied depuis la réponse de NordikNation ...

ses a toi steelson que jai répondu

Bonjour,

alors voici (solution plus rapide, j'aurais du prendre la même méthode pour les 3 parmi 20)

il y a ici 14000 combinaisons

Sub TRIO()
Dim maTable As ListObject
Dim cle As Variant
Dim dico As Object
Set dico = CreateObject("Scripting.Dictionary")

    Set maTable = Sheets("quatro").ListObjects(1)
    ResetTableAvecFormules maTable

    For i = 2 To [A1].End(xlDown).Row
        For j = 1 To Cells(i, 1).End(xlToRight).Column - 3
            For k = j + 1 To Cells(i, 1).End(xlToRight).Column - 2
                For m = k + 1 To Cells(i, 1).End(xlToRight).Column - 1
                    For n = m + 1 To Cells(i, 1).End(xlToRight).Column
                        cle = Cells(i, j) & "|" & Cells(i, k) & "|" & Cells(i, m) & "|" & Cells(i, n)
                        dico(cle) = dico(cle) + 1
                    Next
                Next
            Next
        Next
    Next

    Application.ScreenUpdating = False
    Sheets("quatro").Select
    ligne = 2
    For Each cle In dico.Keys
        Tcle = Split(cle, "|")
        For i = LBound(Tcle) To UBound(Tcle)
            Cells(ligne, i + 1) = Tcle(i)
        Next
        Cells(ligne, 5) = dico(cle)
        ligne = ligne + 1
    Next

    Set maTable = Sheets("quatro").ListObjects(1)
    tri maTable

    Application.ScreenUpdating = True

End Sub

Sub ResetTableAvecFormules(myTable As ListObject)
  With myTable
    With .DataBodyRange
      If .Rows.Count > 1 Then
        .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
      End If
    End With
    If .DataBodyRange(.ListRows.Count, 1) <> "" Then .DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
  End With
End Sub

Sub tri(myTable As ListObject)
    myTable.Sort.SortFields.Clear
    myTable.Sort.SortFields.Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
    With myTable.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

J'ai refait le 3/20 à l'image du 4/20, c'est beaucoup plus rapide !

merci beaucoup

très comptant

content je suppose car c'est gratuit !

quand ses gratuit je suis toujour contant

merci encore