système réduction lotofoot

[titooooo]

bonjour

je sais pas si c'est faisable mais j'essaie

a partir 'une grille qui se compose de plusieurs triple et double et simples

je veut reconstituer en des grilles simple

 

[titooooo]

Re : système réduction lotofoot

bonjour

j'ai trouvé qq chose sur un autre fil

https://www.excel-downloads.com/threads/decomposition-grille-multiples-en-grille-simple.152779/

mais au lieu de 10 match j'ai besoin que le code traite 13 match

merci d'avance

 

[KenDev]

Re : système réduction lotofoot

Bonjour à tous,

Une possibilité avec le code suivant.

Mettre vos grilles (nombre de lignes au choix) en colonnes A:C à partir de la ligne 1.
Pas d'autres données dans ces colonnes.
Lancer la sub depuis cette feuille.
La sub ne vérifie pas la cohérence des entrées.
Nombre de grilles maximum : nombre de colonnes d'une feuille / 3. Revoir affichage si insuffisant.

Cordialement

KD

Sub MulSimple()
    Dim r&, a&, i&, Ta() As Boolean, j As Byte, Tb() As Boolean, Tp() As Byte, k&, ii&, u&, jj&, b$, c As Byte
    For i = 1 To 3
        a = Cells(Rows.Count, i).End(xlUp).Row
        If a > r Then r = a
    Next i
    ReDim Ta(1 To r, 1 To 3)
    For i = 1 To r: For j = 1 To 3: Ta(i, j) = Cells(i, j) <> "": Next j, i
    For i = 1 To r
        a = 0: ReDim Tp(0)
        For j = 1 To 3
            If Ta(i, j) Then a = a + 1: ReDim Preserve Tp(a): Tp(a) = j
        Next j
        If i = 1 Then
            ReDim Preserve Tb(1 To r, 1 To 3, 1 To a)
            For j = 1 To a: Tb(1, Tp(j), j) = True: Next j
        Else
            u = UBound(Tb, 3)
            If a > 1 Then ReDim Preserve Tb(1 To r, 1 To 3, 1 To a * u)
            For j = 1 To a: For jj = 1 To u: For k = 1 To i - 1: For ii = 1 To 3
                    Tb(k, ii, (j - 1) * u + jj) = Tb(k, ii, jj)
                Next ii, k
                For ii = 1 To 3: Tb(i, Tp(j), (j - 1) * u + jj) = True
            Next ii, jj, j
        End If
    Next i
    Erase Ta: Erase Tp
    u = UBound(Tb, 3)
    If MsgBox(u & " grilles, les afficher?", vbYesNo) = vbYes Then
        Sheets.Add
        For j = 1 To u: For i = 1 To r: For k = 1 To 3
                If k = 2 Then b = "x" Else b = k + (k = 3)
                If Tb(i, k, j) Then Cells(i, (j - 1) * 3 + k) = b
            Next k, i
            c = j Mod 2
            Range(Cells(1, (j - 1) * 3 + 1), Cells(r, 3 * j)).Interior.Color = RGB(255 * c, 255 * (1 - c), 0)
        Next j
        Cells.EntireColumn.AutoFit
    End If
End Sub

 

[titooooo]

Re : système réduction lotofoot

Bonjour KenDev et le forum

si ce pas trop demandé , j'ai pas su intégrer le code vba a ma page

serait il possible de mettre une piéce jointe stp

autre chose es ce fonctionnel avec 13 match ou pas encore

merci d'avance et bravo

 

[titooooo]

Re : système réduction lotofoot

bonjour

autant pour moi je l'es essayé et ca marche

mais quel est le nb max de grille a afficher , avec 864 il me dis dépassement de capacité

que faire svp

 

[KenDev]

Re : système réduction lotofoot

Bonsoir,

En effet, maladresse de ma part, remplacer

j as byte

par

j&

Cordialement

KD

 

[titooooo]

Re : système réduction lotofoot

merci et bravo