système réduction lotofoot

  • Initiateur de la discussion Initiateur de la discussion titooooo
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

titooooo

XLDnaute Occasionnel
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
 

Pièces jointes

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

VB:
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
 
Dernière édition:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2016 loto foot
Réponses
0
Affichages
500
Réponses
32
Affichages
743
Retour