Combinaison de chiffre à grande échelle

maxxuknow · 30 Avril 2013

Bonjour, j'ai un code qui me permet de faire la combinaison de chiffre, cependant, lorsque j'arrive à 50 et 7 colonnes, ca ne fonctionne pas. (erreur de mémoire). Existe-t-il une facon de corriger ca? Aussi, j'aimerais ne pas avoir de suite de plus de 2 chiffres, mais j'ai essayer pendant des heures sans succès..

Merci d'Avance,

Max

Sub toto_7()
Dim a&, i&, j&, k&, l&, m&, n&, o&, z&
Dim oDat, sDat(), u&
a = 7
ReDim v(1 To a - 1)
[C1].Resize([C1].End(xlDown).Row, WorksheetFunction.Min(7, [C1].End(xlToRight).Column)).ClearContents
Application.ScreenUpdating = False
oDat = [A1].Resize([A1].End(xlDown).Row, 1).Value
u = UBound(oDat, 1)
For i = 1 To 1
v(1) = oDat(i, 1)
For j = i + 1 To u
v(2) = oDat(j, 1)
For k = j + 1 To u
v(3) = oDat(k, 1)
For l = k + 1 To u
v(4) = oDat(l, 1)
For m = l + 1 To u
v(5) = oDat(m, 1)
For n = m + 1 To u
v(6) = oDat(n, 1)
For o = n + 1 To u
z = z + 1
ReDim Preserve sDat(1 To a, 1 To z)
sDat(1, z) = v(1)
sDat(2, z) = v(2)
sDat(3, z) = v(3)
sDat(4, z) = v(4)
sDat(5, z) = v(5)
sDat(6, z) = v(6)
sDat(7, z) = oDat(o, 1)
Next o
Next n
Next m
Next l
Next k

phlaurent55 · 30 Avril 2013

Re : Combinaison de chiffre à grande échelle

Bonjour Max, et bienvenue sur le forum

Ce programme a été réalisé par Roger2327

je pense qu'il serait plus utile de retourner sur le même fil de discussion et lui poser la question qui te préocupe

à+
Philippe

ROGER2327 · 1 Mai 2013

Re : Combinaison de chiffre à grande échelle

Bonjour maxxuknow.

Je crains que vous vous lanciez dans une entreprise désespérée...
Combiner 50 données 7 par 7 se fait de 99 884 400 façons.
La procédure que j'ai écrite ne permet pas (sur ma machine) de dépasser la combinaison de 24 données 7 par 7.
Il y a 346 104 réponses. Si on les affiche, la feuille de calcul "pèse" plus de 10 Mo. Le temps de calcul dépasse la minute et demie.
En extrapolant à la louche, les ressources nécessaires sont près de 300 fois plus grandes !
Donc je passe la main...

Par contre, si vous voulez entreprendre ce calcul, ce n'est certainement pas pour lire les millions de lignes de résultats : si vous nous disiez quel est le but réellement poursuivi, nous pourrions peut-être imaginer une autre solution que le calcul explicite de près de cent millions de lignes. À vous de voir.

Une remarque : j'ai ressorti le classeur original (il date du 1[SUP]er[/SUP] mars 2010).
Il n'est pas exactement semblable à celui que donnez dans le message #1. Dans toto_7, la ligne

Code:

   For i = 1 To 1

est incorrecte. La ligne originale est :

Code:

   For i = 1 To u

Bon courage !

ROGER2327
#6613

Jeudi 12 Palotin 140 (Réprobation du Travail - Vacuation)
12 Floréal An CCXXI, 5,8619h - sainfoin
2013-W18-3T14:04:07Z

KenDev · 1 Mai 2013

Re : Combinaison de chiffre à grande échelle

Bonjour à tous,

Le code suivant répond à la question de l'affichage total. Les résultats sont affichés sur une (des) nouvelle(s) feuille(s). Code optimisé par Roger2327 puis très légèrement retouché.
(https://www.excel-downloads.com/threads/code-vba-combinaison-5-numero-sur-49.179923/ post 20,21. Le fil contient également d'autres codes en rapport)
Si le traitement est interrompu avant la fin (99 884 400 c'est long) penser à remettre le calcul automatique.
Cordialement

KD

VB:

Sub Pouet()
    Call AffComb(50, 7)
End Sub
Sub AffComb(a&, b&)
    'affiche les combinaisons de b éléments parmis a éléments. (b<= nbr de colonnes)
    Dim i&, j&, NbCmb#, Tb&(), NbWrt#, NbRw&, m&, c%, Tc&(), s&, d&
    If b > a Or b < 2 Or b > Columns.Count Then Exit Sub    'contrôles cohérence
    Application.ScreenUpdating = False: m = Application.Calculation: Application.Calculation = xlCalculationManual
    d = a - b                                               'paramètre (simplifaction)
    NbCmb = WorksheetFunction.Combin(a, b): NbWrt = NbCmb   'nbre de combinaisons total et à écrire
    ReDim Tc(1 To b)                                        'dernière combinaison du bas de feuille
    Application.StatusBar = "Reste à écrire : " & NbWrt     'information
    Do
        Sheets.Add: s = s + 1                               'nouvelle feuille et compteur associé
        Do
            If NbWrt > Rows.Count Then NbRw = Rows.Count Else NbRw = NbWrt  'nbr de combin à écrire pour cette boucle
            ReDim Tb(1 To NbRw, 1 To b)                                     'combinaisons pour cette boucle
            If c = 0 And s = 1 Then
                For i = 1 To b: Tb(1, i) = i: Next i                        'combinaison de départ (cas particulier 1er passage)
            Else                                                            'combinaison de départ pour cette boucle (cas général)
                Tb(1, 1) = Tc(1) - (Tc(2) = d + 2)
                For i = 2 To b - 1
                    If Tc(i + 1) = d + i + 1 Then Tb(1, i) = Tc(i + (Tc(i) = d + i)) + 1 Else Tb(1, i) = Tc(i)
                Next i
                Tb(1, b) = Tc(b + (Tc(b) = a)) + 1
            End If
            For i = 2 To NbRw                                               'combinaisons suivantes
                Tb(i, 1) = Tb(i - 1, 1) - (Tb(i - 1, 2) = d + 2)
                For j = 2 To b - 1
                    If Tb(i - 1, j + 1) = d + j + 1 Then
                        If Tb(i - 1, j) = d + j Then Tb(i, j) = Tb(i, j - 1) + 1 Else Tb(i, j) = Tb(i - 1, j) + 1
                    Else
                        Tb(i, j) = Tb(i - 1, j)
                    End If
                Next j
                If Tb(i - 1, b) = a Then Tb(i, b) = Tb(i, b - 1) + 1 Else Tb(i, b) = Tb(i - 1, b) + 1
            Next i
            Cells(1, 1).Resize(NbRw, b).Offset(0, c * (b + 1)).Value = Tb   'écriture
            NbWrt = Round(NbWrt - NbRw): If NbWrt = 0 Then Exit Do          'reste à écrire...
            For i = 1 To b: Tc(i) = Tb(NbRw, i): Next i                     'dernière combinaison écrite
            c = c + 1                                                       'compteur de colonnes
            Application.StatusBar = "Reste à écrire : " & NbWrt             'information
        Loop Until c * (b + 1) + b > Columns.Count
        c = 0
        Cells.EntireColumn.AutoFit
    Loop Until NbWrt = 0
    Application.ScreenUpdating = True: Application.Calculation = m
End Sub

maxxuknow · 1 Mai 2013

Re : Combinaison de chiffre à grande échelle

Bonjour, oui je l'ai modifié car je croyais que si je pouvais les sortir chiffre par chiffre ca serait moins lourd, mais ca ne fonctionne pas. Je dois donner une série de chiffre pour chacun de mes clients. Alors si je comprends bien il existe pas de façon d'obtenir un fichier contenant les combinaisons possible en 0 et 50 sur 7 chiffres?

Merci,
Max

KenDev · 1 Mai 2013

Re : Combinaison de chiffre à grande échelle

maxxuknow à dit:
oui je l'ai modifié car je croyais que si je pouvais les sortir chiffre par chiffre ca serait moins lourd, mais ca ne fonctionne pas.

??? heu ce code est de moi et optimisé par Roger2327 et n'a rien à voir avec celui que vous avez posté. Ce code fonctionne (pouvant toutefois planter à causes de ressources insuffisantes, auquel cas peut-être revoir le typage des variables et changer la méthode d'écriture (ligne resize)). Le code est en train de tourner sur mon ordi et approche les 30 000 000 de combinaisons affichées pour l'instant sans plantage.

maxxuknow à dit:
combinaisons possible en 0 et 50 sur 7 chiffres?

Désolé je ne comprends pas ce que vous voulez dire. Cordialement

KD

maxxuknow · 1 Mai 2013

Re : Combinaison de chiffre à grande échelle

Ce que je voulais dire, c'est que j'ai changer le u pour le 1 (le message que tu croyais que c'était une erreur). Je suis entrain de tester le nouveau code. Je l'ai recommencer parce que moi ca la planter, mais j'ai pas compris comment le repartir du dernier travail au lieu de recommencera 0?

MErci,
Max

ROGER2327 · 2 Mai 2013

Re : Combinaison de chiffre à grande échelle

Bonsoir à tous.

maxxuknow à dit:
Bonjour, oui je l'ai modifié car je croyais que si je pouvais les sortir chiffre par chiffre ca serait moins lourd, mais ca ne fonctionne pas. Je dois donner une série de chiffre pour chacun de mes clients. Alors si je comprends bien il existe pas de façon d'obtenir un fichier contenant les combinaisons possible en 0 et 50 sur 7 chiffres?

Merci,
Max

Dois-je comprendre qu'il s'agit d'affecter un code unique sous forme d'un arrangement de sept nombres pris entre 0 et 50 inclus ?
Si c'est le cas, voyez si le classeur joint pourrait servir de base de travail.

ROGER2327
#6616

Jeudi 12 Palotin 140 (Réprobation du Travail - Vacuation)
12 Floréal An CCXXI, 9,5432h - sainfoin
2013-W18-3T22:54:13Z

maxxuknow · 5 Mai 2013

Re : Combinaison de chiffre à grande échelle

Bonjour! Le code de Kendev est exactement ce dont je cherchais! Merci beaucoup! Et si je voulais éviter qu'il me sorte des suites de plus de 2 chiffres, avec un if je pourrais faire ca?

Merci!

maxxuknow · 9 Mai 2013

Re : Combinaison de chiffre à grande échelle

Bonjour! Je cherche toujours comment éviter ou sélectionner les suites de nombres (ex: 1 2 3) de ma liste.

Merci,
Max

ROGER2327 · 9 Mai 2013

Re : Combinaison de chiffre à grande échelle

Bonsoir maxxuknow.

maxxuknow à dit:
Bonjour! Je cherche toujours comment éviter ou sélectionner les suites de nombres (ex: 1 2 3) de ma liste.

Merci,
Max

Personnellement, je ne comprends pas la demande. Excusez-moi !

ROGER2327
#6638

Vendredi 20 Palotin 140 (Saint Ti Belot, séide - fête Suprême Quarte)
20 Floréal An CCXXI, 7,6788h - sarcloir
2013-W19-4T18:25:45Z

maxxuknow · 9 Mai 2013

Re : Combinaison de chiffre à grande échelle

Désolé si je manque un peu de clarté. Ce que je veux, c'est d'éviter qu'il me sorte des combinaisons comme 1-2-3-4-5-6. Donc, ce que j'aimerais, c'est pouvoir éviter les suites de nombres de plus de 2 chiffres. Alors, dès qu'il y aurait une combinaisons avec par exemple 20-21-22, ca ne l'écrirait pas. Une manière plus simple d'opérer serait (je crois) de simplement pouvoir les sélectionner de la liste déjà fait et de les supprimer. Un ou l'autre me dérange pas.

Merci beaucoup,
Max

ROGER2327 · 10 Mai 2013

Re : Combinaison de chiffre à grande échelle

Re...

Voyez si le classeur joint permet de créer des séries conformes au besoin...

ROGER2327
#6639

Vendredi 20 Palotin 140 (Saint Ti Belot, séide - fête Suprême Quarte)
20 Floréal An CCXXI, 9,6893h - sarcloir
2013-W19-4T23:15:16Z

P. s. : Je me suis trompé de pièce jointe ! Je la remplace...

maxxuknow · 10 Mai 2013

Re : Combinaison de chiffre à grande échelle

Bonjour, j'aimerais les modifications pour les suite sur le code qui donne tous les combinaisons.. soit celui-ci:

Sub Pouet()
Call AffComb(50, 7)
End Sub
Sub AffComb(a&, b&)
'affiche les combinaisons de b éléments parmis a éléments. (b<= nbr de colonnes)
Dim i&, j&, NbCmb#, Tb&(), NbWrt#, NbRw&, m&, c%, Tc&(), s&, d&
If b > a Or b < 2 Or b > Columns.Count Then Exit Sub 'contrôles cohérence
Application.ScreenUpdating = False: m = Application.Calculation: Application.Calculation = xlCalculationManual
d = a - b 'paramètre (simplifaction)
NbCmb = WorksheetFunction.Combin(a, b): NbWrt = NbCmb 'nbre de combinaisons total et à écrire
ReDim Tc(1 To b) 'dernière combinaison du bas de feuille
Application.StatusBar = "Reste à écrire : " & NbWrt 'information
Do
Sheets.Add: s = s + 1 'nouvelle feuille et compteur associé
Do
If NbWrt > Rows.Count Then NbRw = Rows.Count Else NbRw = NbWrt 'nbr de combin à écrire pour cette boucle
ReDim Tb(1 To NbRw, 1 To b) 'combinaisons pour cette boucle
If c = 0 And s = 1 Then
For i = 1 To b: Tb(1, i) = i: Next i 'combinaison de départ (cas particulier 1er passage)
Else 'combinaison de départ pour cette boucle (cas général)
Tb(1, 1) = Tc(1) - (Tc(2) = d + 2)
For i = 2 To b - 1
If Tc(i + 1) = d + i + 1 Then Tb(1, i) = Tc(i + (Tc(i) = d + i)) + 1 Else Tb(1, i) = Tc(i)
Next i
Tb(1, b) = Tc(b + (Tc(b) = a)) + 1
End If
For i = 2 To NbRw 'combinaisons suivantes
Tb(i, 1) = Tb(i - 1, 1) - (Tb(i - 1, 2) = d + 2)
For j = 2 To b - 1
If Tb(i - 1, j + 1) = d + j + 1 Then
If Tb(i - 1, j) = d + j Then Tb(i, j) = Tb(i, j - 1) + 1 Else Tb(i, j) = Tb(i - 1, j) + 1
Else
Tb(i, j) = Tb(i - 1, j)
End If
Next j
If Tb(i - 1, b) = a Then Tb(i, b) = Tb(i, b - 1) + 1 Else Tb(i, b) = Tb(i - 1, b) + 1
Next i
Cells(1, 1).Resize(NbRw, b).Offset(0, c * (b + 1)).Value = Tb 'écriture
NbWrt = Round(NbWrt - NbRw): If NbWrt = 0 Then Exit Do 'reste à écrire...
For i = 1 To b: Tc(i) = Tb(NbRw, i): Next i 'dernière combinaison écrite
c = c + 1 'compteur de colonnes
Application.StatusBar = "Reste à écrire : " & NbWrt 'information
Loop Until c * (b + 1) + b > Columns.Count
c = 0
Cells.EntireColumn.AutoFit
Loop Until NbWrt = 0
Application.ScreenUpdating = True: Application.Calculation = m
End Sub

MErci,
Max

ROGER2327 · 10 Mai 2013

Re : Combinaison de chiffre à grande échelle

Re...

Serait-ce ceci, par hasard ?

VB:

Sub AffComb(a&, b&)
Dim i&, j&, NbCmb#, Tb&(), NbWrt#, NbRw&, m&, c%, Tc&(), s&, d&
Dim k&
    If b > a Or b < 2 Or b > Columns.Count Then Exit Sub
    Application.ScreenUpdating = False: m = Application.Calculation: Application.Calculation = xlCalculationManual
    d = a - b
    NbCmb = WorksheetFunction.Combin(a, b): NbWrt = NbCmb
    ReDim Tc(1 To b)
    Application.StatusBar = "Reste à écrire : " & NbWrt
    Do
        Sheets.Add: s = s + 1
        Do
            If NbWrt > Rows.Count Then NbRw = Rows.Count Else NbRw = NbWrt
            ReDim Tb(1 To NbRw, 1 To b)

            k = 0

            If c = 0 And s = 1 Then
                For i = 1 To b: Tb(1, i) = i: Next i
            Else
                Tb(1, 1) = Tc(1) - (Tc(2) = d + 2)
                For i = 2 To b - 1
                    If Tc(i + 1) = d + i + 1 Then Tb(1, i) = Tc(i + (Tc(i) = d + i)) + 1 Else Tb(1, i) = Tc(i)
                Next i
                Tb(1, b) = Tc(b + (Tc(b) = a)) + 1

                For j = 1 To b - 2
                    If Tb(1, j) + 1 = Tb(1, j + 1) And Tb(1, j) + 2 = Tb(1, j + 2) Then Exit For
                Next
                If j > b - 2 Then
                    k = 1
                    For j = 1 To b: Tb(k, j) = Tb(1, j): Next
                End If

            End If
            For i = 2 To NbRw
                Tb(i, 1) = Tb(i - 1, 1) - (Tb(i - 1, 2) = d + 2)
                For j = 2 To b - 1
                    If Tb(i - 1, j + 1) = d + j + 1 Then
                        If Tb(i - 1, j) = d + j Then Tb(i, j) = Tb(i, j - 1) + 1 Else Tb(i, j) = Tb(i - 1, j) + 1
                    Else
                        Tb(i, j) = Tb(i - 1, j)
                    End If
                Next j
                If Tb(i - 1, b) = a Then Tb(i, b) = Tb(i, b - 1) + 1 Else Tb(i, b) = Tb(i - 1, b) + 1

                For j = 1 To b - 2
                    If Tb(i, j) + 1 = Tb(i, j + 1) And Tb(i, j) + 2 = Tb(i, j + 2) Then Exit For
                Next
                If j > b - 2 Then
                    k = k + 1
                    For j = 1 To b: Tb(k, j) = Tb(i, j): Next
                End If

            Next i

            Cells(1, 1).Resize(k, b).Offset(0, c * (b + 1)).Value = Tb
            
            NbWrt = Round(NbWrt - NbRw): If NbWrt = 0 Then Exit Do
            For i = 1 To b: Tc(i) = Tb(NbRw, i): Next i
            c = c + 1
            Application.StatusBar = "Reste à écrire : " & NbWrt
        Loop Until c * (b + 1) + b > Columns.Count
        c = 0
        Cells.EntireColumn.AutoFit
    Loop Until NbWrt = 0
    Application.ScreenUpdating = True: Application.Calculation = m
End Sub

Évidemment, c'est du bricolage : la mise en page nécessiterait une révision. (Il vous faudra pour cela faire le dénombrement des solutions, car ce n'est plus Combin(a, b) !)

ROGER2327
#6641

Samedi 21 Palotin 140 (Occultation de Saint Mce le Dr Sandomir - fête Suprême Quarte)
21 Floréal An CCXXI, 8,5738h - staticé
2013-W19-5T20:34:38Z

Effectuez une recherche sur Excel Downloads...

Combinaison de chiffre à grande échelle

maxxuknow

Guest

Pièces jointes

phlaurent55

Nous a quittés en 2020

ROGER2327

XLDnaute Barbatruc

KenDev

XLDnaute Impliqué

maxxuknow

Guest

KenDev

XLDnaute Impliqué

maxxuknow

Guest

ROGER2327

XLDnaute Barbatruc

Pièces jointes

maxxuknow

Guest

maxxuknow

Guest

ROGER2327

XLDnaute Barbatruc

maxxuknow

Guest

ROGER2327

XLDnaute Barbatruc

Pièces jointes

maxxuknow

Guest

ROGER2327

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée