Code VBA qui peine...

J

JJ1

Guest
Bonjour,
J'ai quelques lignes de code qui fonctionnent mais très lentement...
Auriez-vous une idée de turbo !!

Dim cel As Range
Dim a, b, c, d, e, f As Integer
For a = 1 To 50
For b = a + 1 To 50
For c = b + 1 To 50
For d = c + 1 To 50
For e = d + 1 To 50
For f = e + 1 To 50
Range("G1") = a
Range("H1") = b
Range("I1") = c
Range("J1") = d
Range("K1") = e
Range("L1") = f

If [R1] = 0 Then [G1:L1].Copy Range("Y" & Cells(Rows.Count, 28).End(xlUp).Row + 1)' copie de la série
Next
Next
Next
Next
Next
Next



merci beaucoup.

Bon samedi.
 

Paritec

XLDnaute Barbatruc
Re : Code VBA qui peine...

Bonjour Jj1 le forum
et si tu nous mettais le petit fichier avec on pourrait tester
J'avais pas bien regardé ton code, mais si tu travaillais avec des tableaux tu irait au moins 50 fois plus vite, car là tu travailles directement sur la feuille et c'est cela le souci
et aussi tu ne penses pas qu'il va y avoir un petit problème de nombre de lignes car le calcul de 50 puissance 6 = 15 625 000 000 lignes ???????
a te relire pour des explications et après je te fais le code qui va bien
a+
Papou:)
 
Dernière édition:
J

JJ1

Guest
Re : Code VBA qui peine...

Bonjour Papou,

Merci de ta réponse, le nombre de lignes n'est pas un problème car je ne copie que si R1=0 (ce qui sera rare !)
je te joins mon exemple (ne pas tenir compte du NB.SI en R1, c'est pour test, ma vraie formule est plus compliquée....)

Merci encore.



ps: pour info, ma formule cherche une série de 6 nombres de 1 à 70 en G1:L1 dont 5 (donc à fortiori 6) ne sont pas présents dans une ligne de la plage A5:T9500. (d'où la lenteur aussi...)
NOTA: il y a peut-être une autre façon de faire sans passer par les combinaisons?
 

Pièces jointes

  • expapou.xlsm
    177.2 KB · Affichages: 76
Dernière modification par un modérateur:

laurent950

XLDnaute Barbatruc
Re : Code VBA qui peine...

Bonjour Papou,

Je suis arrivé à faire se bout de code, mais une fois Excel lancer peu de temps après
Excel (ne répond pas) donc plus la main sur Excel, la feuille devient pastel avec le message en haut
(Ne répond pas)

J’ai pensé à une « statusbar » pour connaitre la progression des boucles, donc quand Excel (Ne répond plus) j’appuis une fois sur la touche « ECHAP » et la il y a la reprise de la stausbar et ont peu constater la progression des boucles et le décompte de la StatusBar se rafraichi a nouveau et on peu suivre la progression en bas de la page Excel.

Cette macro à l’air très longue mais je ne sais pas si le résultat sera restitué en fin de maco pour cause : Excel (Ne répond pas)


VB:
Sub Alea_bis()


Cells(2, 1) = "Depart : " & Time

Dim T1() As Double
ReDim T1(1 To 1, 1 To 6)

Dim T2() As Double
ReDim T2(1 To 1)
x = 1

'Dim cel As Range
Dim a, b, c, d, e, f As Integer
For a = 1 To 70
For b = a + 1 To 70
For c = b + 1 To 70
For d = c + 1 To 70
For e = d + 1 To 70
For f = e + 1 To 70
Application.StatusBar = "For pos a = " & a & " (soit 70 reste " & 70 - a & " )" & " / " & _
                        "For pos b = " & b & " (soit 70 reste " & 70 - b & " )" & " / " & _
                        "For pos c = " & c & " (soit 70 reste " & 70 - c & " )" & " / " & _
                        "For pos d = " & d & " (soit 70 reste " & 70 - d & " )" & " / " & _
                        "For pos e = " & e & " (soit 70 reste " & 70 - e & " )" & " / " & _
                        "For pos f = " & f & " (soit 70 reste " & 70 - f & " )" & " / "

'Range("G1") = a
T1(1, 1) = a
'Range("H1") = b
T1(1, 2) = b
'Range("I1") = c
T1(1, 3) = c ''
'Range("J1") = d
T1(1, 4) = d
'Range("K1") = e
T1(1, 5) = e
'Range("L1") = f
T1(1, 6) = f

If [R1] = 0 Then
'[G1:L1].Copy Range("Y" & Cells(Rows.Count, 28).End(xlUp).Row + 1) ' mis un exemple nb.si pour test de copie si =0
For g = 1 To UBound(T1, 2)
T2(x) = T1(1, g)
x = x + 1
ReDim Preserve T2(1 To x)
Next g
End If
Next
Next
Next
Next
Next
Next

' Suppression de la derniere case crée du tableau a une dimenssion inutile
' voir la boucle "for g" ou x = x + 1
x = x - 1
ReDim Preserve T2(1 To x)

lign = 1
col = 1

For h = 1 To UBound(T2)
If col > 6 Then
col = 1
lign = lign + 1
End If
Cells(5 + lign, 24 + col) = T2(h)
col = col + 1
Next h

Cells(3, 1) = "Fin : " & Time

Application.StatusBar = False
End Sub

Laurent
 
Dernière édition:

laurent950

XLDnaute Barbatruc
Re : Code VBA qui peine...

Bonjour Modeste,

oui j'ai essayer mais c'est idem cela ne fonctionne comme avant, même avec votre methode en complément de mon programe

Placer au début de la macro
Application.calculation=xlcalculationmanual

placer en fin de macro
application.calculation = xlcalculationautomatic
application.calculate

Laurent
 
J

JJ1

Guest
Re : Code VBA qui peine...

Bonjour Laurent, Modeste,

Idem que vous, aussitôt lancée, le code provoque "Excel ne répond pas" au bout de quelques secondes.
Trop de données?
Je pense rester sur mon code qui est malheureusement très lent...

Merci
Bonne soirée
 

laurent950

XLDnaute Barbatruc
Re : Code VBA qui peine...

Je pense avoir la solution

a la fin de la 4 éme boucle je pose un temps d"arret
Application.Wait (Now + TimeValue("0:00:01"))

La macro se poursuit :
Ligne 2 colonne A = heur de depart
ligne 3 colonne A = heure de fin

Je pense qu'avec cette astuce cela devrais etre bon :

code :

VB:
Sub Alea_bis()

Application.ScreenUpdating = False
Cells(2, 1) = "Depart : " & Time

Dim T1() As Double
ReDim T1(1 To 1, 1 To 6)

Dim T2() As Double
ReDim T2(1 To 1)
x = 1

'Dim cel As Range
Dim a, b, c, d, e, f As Integer
For a = 1 To 70
    For b = a + 1 To 70
        For c = b + 1 To 70
            For d = c + 1 To 70
            Application.Wait (Now + TimeValue("0:00:01"))
                For e = d + 1 To 70
                    For f = e + 1 To 70
                        Application.StatusBar = "For pos a = " & a & " (soit 70 reste " & 70 - a & " )" & " / " & _
                        "For pos b = " & b & " (soit 70 reste " & 70 - b & " )" & " / " & _
                        "For pos c = " & c & " (soit 70 reste " & 70 - c & " )" & " / " & _
                        "For pos d = " & d & " (soit 70 reste " & 70 - d & " )" & " / " & _
                        "For pos e = " & e & " (soit 70 reste " & 70 - e & " )" & " / " & _
                        "For pos f = " & f & " (soit 70 reste " & 70 - f & " )" & " / "
                        
                    'Range("G1") = a
                    T1(1, 1) = a
                    'Range("H1") = b
                    T1(1, 2) = b
                    'Range("I1") = c
                    T1(1, 3) = c ''
                    'Range("J1") = d
                    T1(1, 4) = d
                    'Range("K1") = e
                    T1(1, 5) = e
                    'Range("L1") = f
                    T1(1, 6) = f
                        
                        If [R1] = 0 Then
                            '[G1:L1].Copy Range("Y" & Cells(Rows.Count, 28).End(xlUp).Row + 1) ' mis un exemple nb.si pour test de copie si =0
                            For g = 1 To UBound(T1, 2)
                                T2(x) = T1(1, g)
                                x = x + 1
                                ReDim Preserve T2(1 To x)
                            Next g
                        End If
                    Next f
                Next e
            Next d
        Next c
    Next b
Next a

x = x - 1
ReDim Preserve T2(1 To x)

lign = 1
col = 1

For h = 1 To UBound(T2)
    If col > 6 Then
        col = 1
        lign = lign + 1
    End If
Cells(5 + lign, 24 + col) = T2(h)
col = col + 1
Next h

Cells(3, 1) = "Fin : " & Time

Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Laurent
 
Dernière édition:
J

JJ1

Guest
Re : Code VBA qui peine...

Re,

Effectivement, il n'y a plus de plantage d'Excel....et ce plantage pour une seconde !

Je peux enlever la ' devant ma ligne de copie de la série (pour R1=0) ou ce n'est pas utile avec le tableau ?

As-tu une idée du temps pour passer toutes les combinaisons? je vais le laisser tourner cette nuit dodo !!!

merci à toi.
 
Dernière modification par un modérateur:

laurent950

XLDnaute Barbatruc
Re : Code VBA qui peine...

Pour la ligne :

- ' devant ma ligne de copie de la série (pour R1=0) ou ce n'est pas utile avec le tableau ?
Ce n'est pas utile car au Lieux décrire directement dans la feuille Excel les valeurs sont stocké dans le tableau a une dimension.

Avec la dernière boucle For h je stocke les valeurs dans la feuille.

‘ Pour les données stocké dans le tableau a une dimension en stockant toute les possibilités soit 70 puissance 6 = 117 649 000 000 de cases
Je ne sais pas si cela est possible est à quelle moment il y aura la restriction d’un nombre de case maximum autorisé ?

Pour le tableau a 2 dimension j’utilise une seule ligne avec si cases. Chaque nouvelle valeur écrase l’ancienne à chaque tour de boucles (ici pas de soucis)

Donc en admettant que les 117 649 000 000 de cases du tableau a une dimension soit remplis ? il faut les transférer vers la feuille Excel

Donc : 117 649 000 000 cases / par 6 cases soit = 19 608 166 667 Lignes de 6 Cases

Comme Excel contient = 1 048 576 lignes

Il faut tenir compte de la restitution soit :

19 608 166 667 Lignes de 6 Cases / 1 048 576 lignes d’Excel = 18 700 Tableaux (1 048 576 lignes d’Excel X 6 colonnes Excel)

Donc
1 feuille Excel contient 16 384 Colonnes

En admettant qu’il y est une colonne vide entre deux tableaux cela ferais donc

18 700 Tableaux X 6 cases = soit 112 200 Cases
Et
112 200 cases / 7 colonnes Excel = 16 029 possibilité de tableaux par feuille Excel.

Comme il y a 18 700 Tableau il faut par déduction deux feuilles Excel pour copier toutes les possibilités.

Ps : Ma dernière boucle For h ne copiera qu’un seul tableau parmi les 18 700 Tableaux qu’il faudrait copier soit toutes les
Possibilité.

Dans le principe cela est possible mais il faut penser à l’algorithme pour la dernière boucle h pour repartir toute ces données
Sur l’ensemble des 2 feuilles Excel.

Et si tous ne rentre pas dans un tableau a une dimension il faut trouver aussi une astuce.

Peut-être que j’ai fait une erreur dans mon analyse ?

Pour la seconde d’attente je ne comprends pas pourquoi Excel ne gère pas sans cela il y a une explication mais qui est dur a trouvé ? je vais chercher quand même si vous avez la réponse aussi je suis preneur

Au plaisir de connaitre votre analyse aussi est cela a réussi dans votre répartition en fonction de ce que j’ai compris et de ce qu’il y a à modifier dans la dernière boucle h en espèrent qu’il n’y est pas de limite de case dans le tableau a une dimension ?

Laurent
 
Dernière édition:
J

JJ1

Guest
Re : Code VBA qui peine...

Bonjour Laurent, le Forum

Merci de ta recherche et de ton explication.
Je trouve 131 115 985 combinaisons à 6 nombres sur 70 (70*69*68*67*66*65/6*5*4*3*2*1) et 12 103 014 pour 5 nombres. (l'ordre ne comptant pas)

Vu ton commentaire et avec ces nombres, le tableau devrait passer, sinon je travaillerai avec 5 nombres seulement au lieu de 6 (tu pourras me dire la modification à faire, stp)

Merci, ce n'est pas urgent, profite de ton dimanche.

A+
 

camarchepas

XLDnaute Barbatruc
Re : Code VBA qui peine...

Bonjour ,

Attention au déclaration, ce forum est sensé être un nid d'exemples or :

Code:
Dim a, b, c, d, e, f As Integer

Déclare a,b,c,d et E comme variant et simplement F comme entier.

C'est peut être plus long mais la vraie déclaration en vba est :

Code:
Dim a as integer, b as integer, c as integer ,d as integer, e as integer ,f as integer

utiliser des variables mal déclarée peut aussi causer le plantage des calcul puisque réservation de mémoire abusive.

Cela influe également sur les temps de traitement .
 

laurent950

XLDnaute Barbatruc
Re : Code VBA qui peine...

Bonsoir JJ1 le Forum,

Pour faire suite j’ai fait un teste simple :

Dans un classeur Excel (Nouveau) avec un seul Feuille de ce classeur :

Manipe sans macro.

Cellule de la feuille A1 = j’écris le nombre 1 tous simplement.

Je sélectionne toute les cellules de cette ligne soit de la A1 :XFD1 (avec le clavier Ctrl+D) je remplis toutes les case avec la valeur 1

Ici pas de soucis.

Suite je sélectionne maintenant toute les cellules jusqu’à la dernière ligne 1 048 576

Manipe = Ctrl+B (Pour recopie jusqu’en bas) et le message suivant apparait à l’écran.

J'avais pensé un a tableaux a plusieur dimension, mais la limite est de 60 dimensions.

J'ai trouver un poste sur ce forum mais je pense que se se sera pas adaptable :

le sujet (est dans le premier poste) est la réposnse sur le poste 6.

https://www.excel-downloads.com/thr...usieurs-variables-dans-une-boucle-for.118767/

C'est peux être réalisble par étapes et gérer un peux la mémoire est les tableaux un peux comme le temps d'attente d'une seconde dans la boucle mais ca fait un peu trop de données a gérés, mais je suis ok pour y réfléchir encore.

J'ai peut être une astuce, je vais y réléchir mais au plaisr de parteger avec vous votre savoir.

Laurent

Laurent.
 

Pièces jointes

  • Excel 2010 Feuilles Remplis toutes les cellules avec valeur 1.jpg
    Excel 2010 Feuilles Remplis toutes les cellules avec valeur 1.jpg
    38.8 KB · Affichages: 64
Dernière édition:
J

JJ1

Guest
Re : Code VBA qui peine...

Bonjour Laurent,

Je pense que la mémoire va vite être saturée dans ce tableau!

Quand tu auras un moment, pourras tu me faire les modifications pour passer à 5 nombres au lieu de 6 pour que j'essaye.

Merci à toi.
 

Membres actuellement en ligne

Statistiques des forums

Discussions
313 344
Messages
2 097 337
Membres
106 916
dernier inscrit
Soltani mohamed