Calcul d'occurrences dans une chaine et transfert dans un tableau

Bonjour,

Je continue mon apprentissage en vba. Je progresse à petits pas. Pour cela j'avais téléchargé l'historique de l'euromillions, ce qui me donne une grande base de données.

Mon problème de ce week-end est comment calculer combien de fois apparait une occurrence de 2 ou 3 nombres .... dans l'onglet "extract" et de renseigner le résultat dans l'onglet "comb boules"

Exemple : combien de fois apparait le chiffre 3 associé au 11 et renseigner le résultat dans l'onglet "comb boules" en M6

Merci pour tous vos bons conseils

Hello,

Je ne comprends pas comment tu arrives à 8 en résultat en M6.

T'as les combinaisons 3 et 11 pour 9 lignes :

- Etoiles : 97, 143, 154, 238, 290 et 350

- Boules : 36, 152 et 378

Est ce qu'il y a une particularité pour arriver à 8 ?

@+

C'était juste un exemple, pas le réel résultat

bonjour Car curieuse, Baroute78,

pour vous montrer une solution qui sera trop élevée pour le moment, mais on ne sait jamais.

Sub Compter()
     Dim aA, aOut, aRes, i, j, Fl1
     aA = Sheets("résultats").Range("a1").CurrentRegion     'lire les résultats
     ReDim aOut(1 To UBound(aA) - 1)         'matrice avec les boules des tirages
     For i = 2 To UBound(aA)
          For j = 3 To 7                     'les 5 boules, sans étoiles
               aOut(i - 1) = aOut(i - 1) & "|" & aA(i, j)     'un string avec les boules d'un tirage séparé par "|"
          Next
          aOut(i - 1) = aOut(i - 1) & "|"
     Next

     ReDim aRes(1 To 49, 1 To 50)            'grille des paires
     For i = 1 To UBound(aRes)               'premier numéro
          For j = i + 1 To UBound(aRes, 2)   '2ième numéro
               Fl1 = Filter(aOut, "|" & i & "|", 1)     'filtrer les tirages qui contiennent le premier numéro
               If UBound(Fl1) > -1 Then
                    aRes(i, j) = UBound(Filter(Fl1, "|" & j & "|", 1)) + 1     'filter ceux qui contiennent aussi le 2ième numéro + compter (ajouter 1 parce que base 0)
               Else
                    aRes(i, j) = 0
               End If
          Next
     Next

     Sheets("Comb Boules").Range("C4").Resize(UBound(aRes), UBound(aRes, 2)).Value = aRes     'écrire le résultat
End Sub

bonjour

un essai par formule simple

cordialement

Merci Bart,

J'ai peut-être compris .

Maintenant si je veux faire l'exercice avec 3 boules, il faut que je fasse un autre for k et un autre filtre ?

bonjour,

une proposition pour compter toutes les combinaisons de 1 à 5 boules

re,

Maintenant si je veux faire l'exercice avec 3 boules,

c'est possible, mais comment voulez-vous que je met ces résultats dan votre feuille, j'ai besoin de 48 feuilles, non ?

La méthode avec un dictionaire de @h2so4 fonctionne bien ?

Merci à vous tous.

@h2so4, ce script qui fonctionne très bien, maintenant il va falloir que je travaille pour le comprendre

Bonne soirée

bonsoir,

voici le code avec des commentaires.

Dim dict
Sub aargh()
    Set dict = CreateObject("scripting.dictionary") 'on crée un dictionnaire dans lequel on va compter le nombre d'occurrences d'une séquence de numéros
    With Sheets("résultats") 'on charge le tableau des numéros dans la table vba d
        dl = .Cells(Rows.Count, 1).End(xlUp).Row 'nombre de lignes
        d = .Range("C2:G" & dl)
    End With
    For i = LBound(d) To UBound(d) 'on prend chaque ligne individuellement
        trie d, i 'on trie les numéros de la ligne en ordre croissant
        combin d, i 'on génère toutes les combinaisons de 1,2,3,4 et 5 numéros avec les numéros de cette ligne
    Next i

    'on ecrit les résultats dans une nouvelle feuille
    With Sheets.Add
        .Range("A1").Resize(1, 3) = Split("combinaison,# occurence, # numéros", ",") 'entête
        With .Range("A2") 'position où mettre le tableau du dénombrement
            .Range("A1").Resize(dict.Count, 1) = Application.Transpose(dict.keys) ' les séquences
            .Range("B1").Resize(dict.Count, 1) = Application.Transpose(dict.items) ' leur nombre
            .Range("C1").Resize(dict.Count, 1).FormulaR1C1 = "=len(rc[-2])-len(substitute(rc[-2],""-"",""""))-1" 'nombre de numéros dans la séquence
            .Range("A1").Resize(dict.Count, 3).Sort key1:=.Range("C1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlDescending, key3:=.Range("A1"), order3:=xlAscending, Header:=xlNo 'tri croissant sur le nombre de numéros dans la séquence, puis décroissant sur le nombre d'occurrences, enfin croissant sur la séquence
        End With
        .Range("A1").Resize(1, 3).Columns.AutoFit
    End With
End Sub
Sub combin(d, ligne, Optional n = 1, Optional ni = 1, Optional s = "-")
'code recursif
'd= tableau des numéros
'ligne = ligne du tableau à traiter
'n = niveau de recursion
'ni = valeur de départ pour la boucle i
's = séquence des numéros
    olds = s 'sauvegarde de la valeur de s
    For i = ni To 5
        s = s & Format(d(ligne, i), "00") & "-" ' séquence des numéros
        dict(s) = dict(s) + 1 'on incrémente le compteur pour cette séquence de numéros
        If n < 5 Then combin d, ligne, n + 1, i + 1, s 'on passe au niveau de récursion suivant si on n'a pas encore atteint le niveau 5
        s = olds
    Next i
End Sub

Sub trie(d, ligne)
'tri des éléments de la ligne du tableau d en ordre croissant
    For i = 1 To 4 'on prend tous les numéros de la ligne 1 par 1
        k = i 'on initialise l'indice du nombre le plus petit par ceux encore à trier
        For j = i + 1 To 5 'on prend tous les numéros suivant le numéro d'indice i
            If d(ligne, k) > d(ligne, j) Then k = j 'si on trouve un numéro plus petit on adapte l'indice du nombre le plus petit
        Next j
        If k <> i Then a = d(ligne, i): d(ligne, i) = d(ligne, k): d(ligne, k) = a 'on échange l'élément d'indice i avec l'élément le plus petit trouvé (indice k)
    Next i
End Sub

Merci beaucoup h2so4. Je vais m'entrainer maintenant.

Bonne journée à vous