Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
Vieux 14/03/2010, 09h44   #1
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
Par défaut Simplification de boucles FOR avec concaténation ?

Bonjour,

J'ai débuté le codage sous VBA depuis pas longtemps, et je rencontre actuellement pour plusieurs de mes codes un problème récurrent.
Lorsque je fais une boucle FOR quelconque, mais répétitive: je sui obligé d'écrire :
Code :
1
2
3
4
5
6
7
8
9
10
 
For i = 1 to 15
  Table1= blabla
Next
 
For i = 1 to 15
  Table2 = blibli
Next
 
etc...
ou encore
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
   For Ne = 2 To 40
    ReDim TabC(3, 1): N°T = N°T + 1
    Select Case Ne
     Case Is = 2:  Result2 Cible, Np, TabC
     Case Is = 3:  Result3 Cible, Np, TabC
     Case Is = 4:  Result4 Cible, Np, TabC
     Case Is = 5:  Result5 Cible, Np, TabC
     Case Is = 6:  Result6 Cible, Np, TabC
     Case Is = 7:  Result7 Cible, Np, TabC
     Case Is = 8:  Result8 Cible, Np, TabC
     Case Is = 9:  Result9 Cible, Np, TabC
     Case Is = 10:  Result10 Cible, Np, TabC
     Case Is = 11:  Result11 Cible, Np, TabC
     Case Is = 12:  Result12 Cible, Np, TabC
     Case Is = 13:  Result13 Cible, Np, TabC
     Case Is = 14:  Result14 Cible, Np, TabC
     Case Is = 15:  Result15 Cible, Np, TabC
     Case Is = 16:  Result16 Cible, Np, TabC
     Case Is = 17:  Result17 Cible, Np, TabC
     Case Is = 18:  Result18 Cible, Np, TabC
     Case Is = 19:  Result19 Cible, Np, TabC
     Case Is = 20:  Result20 Cible, Np, TabC
     Case Is = 21:  Result21 Cible, Np, TabC
     Case Is = 22:  Result22 Cible, Np, TabC
     Case Is = 23:  Result23 Cible, Np, TabC
     Case Is = 24:  Result24 Cible, Np, TabC
     Case Is = 25:  Result25 Cible, Np, TabC
     Case Is = 26:  Result26 Cible, Np, TabC
     Case Is = 27:  Result27 Cible, Np, TabC
     Case Is = 28:  Result28 Cible, Np, TabC
     Case Is = 29:  Result29 Cible, Np, TabC
     Case Is = 30:  Result30 Cible, Np, TabC
     Case Is = 31:  Result31 Cible, Np, TabC
     Case Is = 32:  Result32 Cible, Np, TabC
     Case Is = 33:  Result33 Cible, Np, TabC
     Case Is = 34:  Result34 Cible, Np, TabC
     Case Is = 35:  Result35 Cible, Np, TabC
     Case Is = 36:  Result36 Cible, Np, TabC
     Case Is = 37:  Result37 Cible, Np, TabC
     Case Is = 38:  Result38 Cible, Np, TabC
     Case Is = 39:  Result39 Cible, Np, TabC
     Case Is = 40:  Result40 Cible, Np, TabC
    End Select
Next
J'ai plein de codes qui semblent "redondants" dans le même genre.
J'essaie donc de simplifier pour le dernier exemple par exemple, avec:
Code :
1
2
3
4
5
6
7
 
For Ne = 2 to 40
    ReDim TabC(3, 1): N°T = N°T + 1
    Select Case Ne
       Case Is = Ne:  ("Result" & Ne) Cible, Np, TabC
    End Select
Next
Il fait bien la concaténation, mais ne reconnait pas le nom généré Result26 (par exemple) comme étant une variable, mais comme une simple String (vide en l'occurence).
... et pas de bol misterVBA connait pas la fonction magique INDIRECT()

Mes recherches sur google n'ont donné que des cas liés aux noms de feuilles, ou choper une valeur via une adresse(Range(Range())), ce qui n'est pas du tout le cas ici...

En résumé, comment convertir une chaîne string en référence (d'un objet déjà existant) ? (dans mes codes, les objets sont en général des tableaux de type Variant/Variant)

Merci d'avance pour vos réponses.

Dernière modification par Masamunai ; 14/03/2010 à 14h30.
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 14/03/2010, 16h35   #2
Membre Expert
 
Inscription : juillet 2007
Messages : 2 134
Détails du profil
Informations forums :
Inscription : juillet 2007
Messages : 2 134
Points : 2 154
Points : 2 154
Salut Masamunai et le forum
Tu comme ci et si ça ne marche pas, tu fais comme ça
Et si tu ne comprends pas, alors explique clairement ce que tu veux, pas la manière que tu utilises, mais le but. On ne peux simplifier une macro, il faut savoir ce qu'elle doit faire. La méthode utilisée n'est intéressante que pour éviter de l'avoir en réponse.
Code :
1
2
3
4
 For Ne = 2 To 40
    ReDim TabC(3, 1): N°T = N°T + 1
    Select Case Ne
     Case Is = 2:  Result2 Cible, Np, TabC
Je ne suis pas suis de ce que tu veux faire : Redim est une instruction pour redimensionner un tableau de variable, ici TabC, mais tu ne le redimensionnes pas, puisque ses dimensions sont en "dur" (3 et 1).
Select Case est intéressant pour assurer un certain nombre de test, mais si tu ne veux que tester une seule valeur, un simple If suffit.
A+
Gorfael est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 14/03/2010, 18h30   #3
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
A ben désolé si je n'ai pas été clair malgré le titre du topic et 2 exemples... mais merci pour ta réponse.

Mon but est simple en fait:

je cherche à simplifier/optimiser mes codes, et là la 1ère chose que je remarque sont les répétitions, lesquelles sautent pourtant aux yeux :S

Dans le 1er exemple c'était les "Tablei" , est il possible de ne faire qu'une seule boucle "nommant" chaque tableau Tablei avec le bon integer i ?

Dans le 2e exemple, on voit une liste de 40 "Case is", mais on remarque que les appels de procédures "Resulti" ont le même indice que les "Case i" (et cet indice = Ne c'est cool ^^), là encore est-il possible de faire une boucle pour simplifier tout ça ?

Le problème est qu'à chaque fois que j'essaie d'écrire une boucle du genre :

Code :
1
2
3
4
5
6
 
For i = 2 to 40
  For j= 1 to 15
     "Table" & i = calcul compliqué fonction de j
  End For
End For
...pour le 1er exemple

Code :
1
2
3
4
For Ne = 2 to 40
   déclarations blabla...
   ("Result" & Ne) Cible, Np, TabC
End For
... pour le 2e exemple (j'avoue je n'avais pas pensé que je pouvais encore + simplifier en virant l'instruction Case)

Ce serait plus simple, non?

Mais dans les 2 exemples, j'obtiens des erreurs d'incompatibilité de type ou d'objet "inconnu", alors que les Tablei et les procs Resulti sont déjà construites, définies etc... (les codes initiaux marchent d'ailleurs). Voilà pourquoi je comprends pas très bien alors que la concaténation de ces noms semble se faire correctement mais apparemment VBA est pas foutu de savoir que -par exemple- pour i=7, ("Result" & i)=Result7 corresponds à un appel à la procédure nommée Result7, ou encore que "Table" & i = Table7 corresponds au tableau de nom Table7, etc...

Je viens de passer l'après-midi a tenter avec une variable intermédiaire déclarée en Variant, avec .Object.Name, avec .Find, ... aucune méthode ne pige un nom concaténé >< je suis à court d'idées là ;;

EDIT: je précise qu'il n'y a aucun private, ce sont des codes vraiment basiques.
EDIT2: s'il y a vraiment besoin, je peux toujours poster les fichiers correspondants à ces 2 bouts de code (m'a pas semblé nécessaire vu qu'il ne s'agit qu'une histoire de syntaxe toute bête mais fort énervante pour un débutant comme moi)

Dernière modification par Masamunai ; 14/03/2010 à 18h57.
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 14/03/2010, 18h48   #4
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 431
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 31
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 431
Points : 4 042
Points : 4 042
Envoyer un message via MSN à Qwazerty
Salut
Ce qui est claire a tes yeux par ce que tu as le nez collé sur ton problème, ne l'ai pas forcement pour nous qui te lisons.
Ceci etant dis

Pour ton 1er problème
Code :
1
2
3
4
5
6
7
8
9
10
Sub test1_Masamunai()
Dim Table(1, 14) As Single 'crée 2 tableau de single (de 0 à 1) contenant chacun 15 valeur (de 0 à 14)
Dim i As Integer, j As Integer
 
For i = 0 To 1 'Boucle table
    For j = 0 To 14 'Boucle valeur de "table i"
        Table(i, j) = 14 / (j + 1)
    Next
Next
End Sub
A++
Qwaz

Oulala wala j'avais pas tout lu....

Citation:
mais apparemment VBA est pas foutu de savoir que -par exemple- pour i=7, ("Result" & i)=Result7 corresponds à un appel à la procédure nommée Result7
Lol, donc inutil d'insulter vb, car a mon avis peu de langage interpreterait du text comme etant une procedure ..; et j'oserais dire heureusement car ce serait un sacré bordel, il faudrait faire attention a tous moment a ne pas créer une chaine qui est le meme nom qu'une procedure

En somme si tu as ce type de problème ça n'est pas lier a un problème venant du langage, mais a un problème lier a la construction de tes procédures

Tu dois rendre ta procédure polyvalente afin qu'elle gère tous les cas lié a un numéro Ne. Montre nous l'intérieur de ces multiple procédure qui on certainement toutes le même code.

A++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Score PowerBall Gyroscope Green : 11847

Dernière modification par AlainTech ; 09/05/2010 à 14h29. Motif: Fusion de 2 messages
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 14/03/2010, 19h09   #5
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
Oula je n'avais pas vu votre réponse super rapide Qwazerty.

Ok ci-joint les 2 fichiers contenant le + de "répétitions" dont je cherche à simplifier.
Les 2 traitent la même chose: générer des permutations avec SommeMatching, et on été développées en partenariat avec le forum VeriTi.net et plus spécialement Marco57.
Le 1er est ma dernière version, tandis que le 2e est celui de Marco qui comme vous le verrez semble bien + "pro" :p
Bref là n'est pas la question. Je souhaiterait apprendre à éviter les répétitions de codes (qui entraineront peut etre un gain de vitesse d'éxécution), mais je me heurte à ce qui semble être un banal problème de syntaxe... que j'aurais réglé sans problème avec la fonction INDIRECT() sous Excel, mais sous VBA ben.... .
Vous trouverez donc dans ces 2 fichiers, outre les 2 exemples précités, plein d'autres répétitions "lourdes" à lire.

En espérant que cela vous aide à y voir plus clair. (désolé si j'ai trop simplifié le post d'origine)

Dernière modification par Masamunai ; 18/03/2010 à 09h57.
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 14/03/2010, 19h35   #6
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 431
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 31
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 431
Points : 4 042
Points : 4 042
Envoyer un message via MSN à Qwazerty
Re
Pour le debut
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Private Sub Worksheet_Change(ByVal Target As Range) ' Marco57 de VeriTi.net, et R.Morineau, Mars2010
'la ligne suivante declare les dest de 1 a 14 en type variant et seulement Dest15 en range
'Dim Dest1, Dest2, Dest3, Dest4, Dest5, Dest6, Dest7, Dest8, Dest9, Dest10, Dest11, Dest12, Dest13, Dest14, Dest15 As Range
'il faut repeter as ... en vb
'Dim Dest1 As Range, Dest2 As Range, Dest3 As Range, Dest4 As Range, Dest5 As Range, Dest6 As Range, Dest7 As Range, Dest8 As Range, Dest9 As Range, Dest10 As Range, Dest11 As Range, Dest12 As Range, Dest13 As Range, Dest14 As Range, Dest15 As Range
'Mais comme expliqué dans mon autre message il faut faire des tableaux, ici un tableau de range
Dim DestRange(14) As Range 'a mettre a la place de la declaration des 15 Dest
Dim xDest As Integer
 
Dim Col As New Collection, Cible%, NbM%, cNbM%, Diff%, NbR
Dim x%, i%, x0%, x1%, x2%, x3%, x4%, x5%, x6%, x7%, x8%, x9%, x10%, x11%, x12%, x13%, x14%, N%, R%
ReDim Table2(2, 0), Table3(2, 0), Table4(2, 0), Table5(2, 0), Table6(2, 0), Table7(2, 0), Table8(2, 0), Table9(2, 0), Table10(2, 0), Table11(2, 0), Table12(2, 0), Table13(2, 0), Table14(2, 0), Table15(2, 0)
'Idem 1ere remarque
Dim x0min, x1min, x2min, x3min, x4min, x5min, x6min, x7min, x8min, x9min, x10min, x11min, x12min, x13min, x14min As Integer
 
  If Not Intersect(Target, Union([Data], [NbMembres], [SomCible])) Is Nothing Then
   If Intersect(Target, Union([Data], [NbMembres], [SomCible])).Cells.Count = 1 Then
    Cible = [SomCible].Value
    NbM = [NbMembres].Value
    For x = 1 To [Data].Cells.Count
      Col.Add [Data].Cells(x), CStr(x)
      If [Data].Cells(x) > 0 Then
        N = x - 1 'Nbre maxi correspondant à la dernière donnée non-nulle
        R = R + 1 'Nbre réel de données non nulles (sans celles nulles avant N)
      End If
    Next x
    If Not 2 <= Col.Count <= 9 Then
     MsgBox "Le Nombre de Probabilité(s) Différente(s) de Zéro n'est pas correct": Exit Sub
    End If
    If 1 > NbM Or NbM > 15 Then
     MsgBox "Le Nombre de Membres doit être un Entier entre 1 et 15 (inclus)": Exit Sub
    End If
 
    While Fact(R + i) / (Fact(i) * Fact(R)) < 65000 And i <= NbM 'Protection anti-saturation
        cNbM = i 'Nbre de membres max/uplet corrigé
        i = i + 1
    Wend
 
    For xDest = 1 To 14
        Set DestRange(xDest) = Range("Dest" & xDest & "Uplets").Cells
    Next
    'remplace tous les set
    'Set Dest2 = [Dest2Uplets].Cells
    'Set Dest3 = [Dest3Uplets].Cells
    'Set Dest4 = [Dest4Uplets].Cells
    'Set Dest5 = [Dest5Uplets].Cells
    'Set Dest6 = [Dest6Uplets].Cells
    'Set Dest7 = [Dest7Uplets].Cells
    'Set Dest8 = [Dest8Uplets].Cells
    'Set Dest9 = [Dest9Uplets].Cells
    'Set Dest10 = [Dest10Uplets].Cells
    'Set Dest11 = [Dest11Uplets].Cells
    'Set Dest12 = [Dest12Uplets].Cells
    'Set Dest13 = [Dest13Uplets].Cells
    'Set Dest14 = [Dest14Uplets].Cells
    'Set Dest15 = [Dest15Uplets].Cells
    [Results].Cells.ClearContents
Pour le reste du code j'ai besoin d'un moment pour le comprendre un minimum, mais il me semble qu'il faille appeler récursivement une procédure

++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Score PowerBall Gyroscope Green : 11847
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 14/03/2010, 19h59   #7
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
a oui tu as raison, j'aurais du m' "entrainer" sur ce bout là... je me cassait les dents sur le bout de code se trouvant à la fin, avec les lignes des transpose(Table).

Merci beaucoup pour ce début de réponse, on dirait qu'il faut que je mette mes noms concaténés entre parenthèses d'un type donné pour qu'ils soient reconnus par VBA, si j'ai bien compris ? (comme Range("Dest" & i) )
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 14/03/2010, 22h28   #8
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 431
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 31
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 431
Points : 4 042
Points : 4 042
Envoyer un message via MSN à Qwazerty
Essais d'expliquer un peu plus le but du code, car perso j'ai du mal a mis retrouver dans toutes ces boucles.
Instinctivement au vu des résultat et de la structure des boucles, je dirais que seul la dernière la plus longue doit être conservée, les autre boucle retourne un résultat partiel.
On garde a chaque fois x valeurs en partant de la droite, x étant le nombre d'uplets (défini UpLets s'il te plait) et on supprime les doublons.

Juste pour info, c'est quel jeu? Lineage2 peut être?

une piste de simplification; si tu reproduit la meme chose sur toutes tes boucle ca réduira deja un peu la taille, a toi de voir si les résultats obtenus sont cohérents.

Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
    For x14 = 0 To N
      For x13 = x14 To N
        For x12 = x13 To N
          For x11 = x12 To N
            For x10 = x11 To N
              For x9 = x10 To N
                For x8 = x9 To N
                  For x7 = x8 To N
                    For x6 = x7 To N
                      For x5 = x6 To N
                        For x4 = x5 To N
                          For x3 = x4 To N
                            For x2 = x3 To N
                              For x1 = x2 To N
                                For x0 = x1 To N
                                  If Col(x14 + 1).Value > 0 And Col(x13 + 1).Value > 0 And Col(x12 + 1).Value > 0 And Col(x11 + 1).Value > 0 And Col(x10 + 1).Value > 0 And Col(x9 + 1).Value > 0 And Col(x8 + 1).Value > 0 And Col(x7 + 1).Value > 0 And Col(x6 + 1).Value > 0 And Col(x5 + 1).Value > 0 And Col(x4 + 1).Value > 0 And Col(x3 + 1).Value > 0 And Col(x2 + 1).Value > 0 And Col(x1 + 1).Value > 0 And Col(x0 + 1).Value > 0 And (Cible = 0 Or x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 + x13 + x14 = Cible) Then
                                    Table15(0, UBound(Table15, 2)) = "( " & x14 & " ; " & x13 & " ; " & x12 & " ; " & x11 & " ; " & x10 & " ; " & x9 & " ; " & x8 & " ; " & x7 & " ; " & x6 & " ; " & x5 & " ; " & x4 & " ; " & x3 & " ; " & x2 & " ; " & x1 & " ; " & x0 & " )"
                                    Table15(1, UBound(Table15, 2)) = Col(x0 + 1) * Col(x1 + 1) * Col(x2 + 1) * Col(x3 + 1) * Col(x4 + 1) * Col(x5 + 1) * Col(x6 + 1) * Col(x7 + 1) * Col(x8 + 1) * Col(x9 + 1) * Col(x10 + 1) * Col(x11 + 1) * Col(x12 + 1) * Col(x13 + 1) * Col(x14 + 1)
                                    Table15(2, UBound(Table15, 2)) = Fact(15) / CompteDoublons(Table15(0, UBound(Table15, 2)), Col)
                                    ReDim Preserve Table15(2, UBound(Table15, 2) + 1)
                                  End If
                                Next
                              Next
                            Next
                          Next
                        Next
                      Next
                    Next
                  Next
                Next
              Next
            Next
          Next
        Next
      Next
    Next
Mais il est sur qu'un simplification est possible, mais je la vois pas de suite, je vais aller me coucher ça ira mieux demain


A++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Score PowerBall Gyroscope Green : 11847
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 14/03/2010, 23h51   #9
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
Pour l'application, cela n'a rien à voir avec un jeu, c'est pour un des services de ma boîte dans le cadre d'une simulation.

Pour le principe, il s'agit de connaître la probabilité globale pour un certain nombre d'essais, en utilisant que certaines valeurs connues (chacune ayant sa propre probabilité d'apparition). Ces essais sont alors représentés sous forme de "X-uplets", par exemple un 5-uplet = 5 essais indépendants consécutifs, cela en utilisant que 9 chiffres possibles présentés en ligne dans les fichiers, avec leurs probas respectives juste en-dessous.

En termes d'implémentation, j'avais d'abord fait un code générant toutes les permutations possibles à partir des nombres dont la probabilité individuelle est non-nulle. Je me suis retrouvé très vite limité à des 6-uplets en n'utilisant que 3 chiffres à proba non nulle... saturation mémoire au delà. Or la simulation nécessite de pouvoir tester avec 9 chiffres à proba non nulle, et pour des X-uplets pouvant aller assez "loin", càd ~30...
J'ai donc "réduit" cette génération en me basant sur la propriété que les permutations avec répétition sont en fait des permutations simples à partir de combinaisons avec répétitions, lesquelles sont beaucoup moins nombreuses à générer. Un exemple est expliqué à l'adresse http://fr.wikipedia.org/wiki/Combina...9p%C3%A9tition. Vers la fin, juste avant les algos, il y a un tableau permettant de visualiser comment générer ces combinaisons avec répétitions, je me suis donc basé sur ce tableau-exemple pour coder les 15 boucles que vous voyez dans mon fichier.
Ensuite, ces combinaisons ne représentant qu'une partie de la solution souhaitée, il restait à trouver les permutations simples issues de celles-ci. Là par contre, pas besoin de les générer, on a juste besoin de leur nombre, lequel est défini sur wikipedia aussi, et est calculé puis affiché en 3e colonne à côté de chaque uplet généré.
J'ai également utilisé un "seuil" recherché : il s'agit tout simplement de la somme des membres d'un uplet. Donc si au cours d'une boucle, les chiffres utilisés pour "former" un uplet ont une somme différente de ce seuil SommeCible => on reboucle chiffre suivant, sans former l'uplet en question qui est alors "rejeté". Pas besoin de routine de suppression, et aucun risque de doublon.
Enfin, Marco de Veriti.net m'a aidé pour la mise en forme de ces boucles et appris pas mal de trucs, en particulier pour implémenter ce seuil "SommeCible".
Au final, on arrive déjà à arriver jusqu'aux 15-uplets sans trop trop "ramer".

Exemple: j'ai "0" "1" et "5" avec respectivement 10% 86.7% et 3.3% de chances d'apparition, quels sont donc les Xuplets possibles avec répétition possible, pour avoir un seuil SommeCible=6 ?
La macro génére donc seulement (pour les triplets):
Code :
1
2
3
1ère Colonne            2e col.   3e col.
(015)    10%*86.7%*3.3%=0.286%      4
(me principe pour 2uplets 4uplets et au delà)
Les autres permutations simples possibles à partir de cette combinaison étant:
(051) (105) (150) -> 4 permutations avec répétition au total respectant la somme = 6. Enfin, dans le tableau résultats on sommeprod les probas résultantes de chaque Xuplet généré avec son nombre. Ce tableau résultats sera ensuite intégré dans la simulation, laquelle envoie aussi les paramètres en entrée (chiffres à utiliser, SommeCible et probas).

Donc oui le fichier fonctionne, mais alors j'ai attrapé pas mal de crampes aux doigts à copier-coller toutes ces boucles... je me suis arrêté "que" à 15 :s Marco lui a été plus loin jusqu'à 40 je n'ai pas encore étudié son fichier à fond pour adapter ses idées, mais déjà ses résultats collent pas exactement mais surtout il plante au delà des 9uplets avec 9 chiffres à proba non-nulle ;; (le mien aussi mais j'ai mis un test d'arrêt théorique sur 65000, pas de génération au delà).
Bref, là je vois pas trop comment faire mieux, à part continuer à étudier le fichier de Marco, et supprimer ces boucles répétitives en espérant un gain en optimisation (et lisibilité). C'est l'objet de ce post ici.
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/03/2010, 07h20   #10
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 431
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 31
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 431
Points : 4 042
Points : 4 042
Envoyer un message via MSN à Qwazerty
Salut
Je n'ai pas tout lu, je regarderai ce soir.
Mais je pense avoir une solution de boucle polyvalente (je savais bien que la nuit porte conseil ), il faut laisser tomber les boucles for, je te montrerais ce soir.
Pour ton problème de saturation, au lieu d'utiliser 15 tableau, il serait plus judicieux d'en utiliser 1 seul puis a chaque fois qu'une boucle for actuel est fini tu inscrit les résultat dans le tableau excel, ainsi pour les calcule suivant tu réutilises le même tableau que tu auras vidé au préalable.
Concrètement a l'heure actuel il faudrait mettre chaque lige transpose sont la boucle qui rempli le tableau associé et vider ce tableau associé pour libéré de la mémoire.
Donc la question est veux tu calculer toutes les solutions ?
Si j'ai saisi, il suffirait de faire a chaque fois les boucles de 0 à N et non plus de Xn-1 à N comme actuellement?
A++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Score PowerBall Gyroscope Green : 11847
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/03/2010, 10h31   #11
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
Bonjour,

Pour ta question en gras, relis l'explication de mon post au dessus stp, en particulier les conditions utilisées pour limiter la génération (Combi seules + SommeMatching). Il y a aussi plein de commentaires dans les fichiers excel ET dans le code VBA. Ces 2 conditions se voient également dans TOUTES les boucles aussi...
Cependant, pour des raisons de déboguage, oui il est utile de voir tous les uplets générés pour voir si le code fonctionne, c'est pour ça que tu vois à l'intérieur de toutes ces boucles un If SommeCible=0 supplémentaire, alors qu'il s'agit de l'objectif à atteindre (donc forcément > de 0).

Je suis effectivement d'accord avec toi d'avoir eu le même "feeling" qu'il serait tout à fait possible de remplacer toutes ces boucles par quelque chose de "polyvalent" comme tu dis. Mais, outre mes connaissances très limitées en VBA, ces boucles sont particulières pour 2 raisons:
a) Si tu a suivi le tableau sur wikipedia, tu t'apercevra que ces boucles sont en fait "rétrécissantes" à chaque rebouclage, càd que quand la dernière boucle (la plus basse x0) a fini, il y a un set de cette variable x0min à +1, ce qui fait que la boucle suivante bouclera 1x moins. pareil pour les autres for au dessus dans la même boucle.
b) Quant on passe d'une boucle à la suivante, pour générer l'uplet suivant, il faut rajouter une variable xN de plus, distincte des autres, vu que l'uplet a 1 membre de plus. Si tu raisonnes dans le sens inverse, càd garder la plus grosse (et y en a pas en fait vu que c'est moi qui me suis arrêté à 15, pourrait très bien être 30 ou 40?), je ne suis pas sûr de deviner comment tu compterait faire... Bref si:
Citation:
Si j'ai saisi, il suffirait de faire à chaque fois les boucles de 0 à N et non plus de Xn-1 à N comme actuellement ?
va donner quoi comme résultats selon toi ?

Remplacer ca ça par quelquechose sans For ? honnetement je vois pas du tout concretement, j'ai hâte à ce soir

EDIT: oula j'avais pas vu quelquechose dans ton format de boucle précédent post : xN = xN+1. J'essaie et je post si résultats toujours cohérents.
EDIT2: ok les résultats sont toujours les mêmes avec cette astuce, Merci bcp Qwaz

Dernière modification par Masamunai ; 15/03/2010 à 12h54.
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/03/2010, 12h15   #12
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
En attendant ce soir j'ai essayé d'appliquer tes conseils de syntaxe :

Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
    ' Préparation zones d'affichage
    Dim DestRange(15) As Range, xDest As Integer
    For xDest = 2 To 15
        Set DestRange(xDest) = Range("Dest" & xDest & "Uplets").Cells 'Erreur: la méthode Range a échoué
    Next
    [Results].Cells.ClearContents
 
    ' Préparation des tableaux d'uplets
    ReDim Table1(2, 0), Table2(2, 0), Table3(2, 0), Table4(2, 0), Table5(2, 0), Table6(2, 0), Table7(2, 0), Table8(2, 0), Table9(2, 0), Table10(2, 0), Table11(2, 0), Table12(2, 0), Table13(2, 0), Table14(2, 0), Table15(2, 0)
    Dim Table() As New Collection, xT As Integer
    For xT = 1 To 15 ' Chaque élément de Table est un tableau de Variants de 3 lignes et 1 colonne
'        Dim "Table" & xT as variant
'        ReDim ("Table" & xT)(2, 0)
'        ReDim Table.Item(xT) (2, 0)
    Next
... et à la fin du code:
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
'    For xDest = 1 To 15
'      If UBound("Table" & xDest, 2) <> 0 Then
'        DestRange(xDest).Resize(UBound("Table" & xDest, 2), 3) = WorksheetFunction.Transpose("Table" & xDest)
'      End If
'    Next
 
    If UBound(Table2, 2) <> 0 Then Dest2.Resize(UBound(Table2, 2), 3) = WorksheetFunction.Transpose(Table2)
    If UBound(Table3, 2) <> 0 Then Dest3.Resize(UBound(Table3, 2), 3) = WorksheetFunction.Transpose(Table3)
    If UBound(Table4, 2) <> 0 Then Dest4.Resize(UBound(Table4, 2), 3) = WorksheetFunction.Transpose(Table4)
    If UBound(Table5, 2) <> 0 Then Dest5.Resize(UBound(Table5, 2), 3) = WorksheetFunction.Transpose(Table5)
    If UBound(Table6, 2) <> 0 Then Dest6.Resize(UBound(Table6, 2), 3) = WorksheetFunction.Transpose(Table6)
    If UBound(Table7, 2) <> 0 Then Dest7.Resize(UBound(Table7, 2), 3) = WorksheetFunction.Transpose(Table7)
    If UBound(Table8, 2) <> 0 Then Dest8.Resize(UBound(Table8, 2), 3) = WorksheetFunction.Transpose(Table8)
    If UBound(Table9, 2) <> 0 Then Dest9.Resize(UBound(Table9, 2), 3) = WorksheetFunction.Transpose(Table9)
    If UBound(Table10, 2) <> 0 Then Dest10.Resize(UBound(Table10, 2), 3) = WorksheetFunction.Transpose(Table10)
    If UBound(Table11, 2) <> 0 Then Dest11.Resize(UBound(Table11, 2), 3) = WorksheetFunction.Transpose(Table11)
    If UBound(Table12, 2) <> 0 Then Dest12.Resize(UBound(Table12, 2), 3) = WorksheetFunction.Transpose(Table12)
    If UBound(Table13, 2) <> 0 Then Dest13.Resize(UBound(Table13, 2), 3) = WorksheetFunction.Transpose(Table13)
    If UBound(Table14, 2) <> 0 Then Dest14.Resize(UBound(Table14, 2), 3) = WorksheetFunction.Transpose(Table14)
    If UBound(Table15, 2) <> 0 Then Dest15.Resize(UBound(Table15, 2), 3) = WorksheetFunction.Transpose(Table15)
    Erase Table2, Table3, Table4, Table5, Table6, Table7, Table8, Table9, Table10, Table11, Table12, Table13, Table14, Table15
Aucune syntaxe de simplification ne fonctionne... VB n'aime vraiment pas qu'on joue dynamiquement avec les noms de variables... J'ai posté cela afin de donner une idée aux lecteurs de l'objet initial du post, vu qu'apparemment je n'ai pas été clair du tout.
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/03/2010, 12h33   #13
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 431
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 31
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 431
Points : 4 042
Points : 4 042
Envoyer un message via MSN à Qwazerty
Salut
Petite réponse vite faite, comme je e l'ai dis je n'ai pas eu le temps de regarder le lien wiki, ni mm de pris le temps de bien lire tes dernières post.

J'avais edité un message et donc tu as du passer a coté, j'expliquer la notion de Xn-1 à N j'avauis posté ce type de boucle
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
    For x14 = 0 To N
      For x13 = x14 To N
        For x12 = x13 To N
          For x11 = x12 To N
            For x10 = x11 To N
              For x9 = x10 To N
                For x8 = x9 To N
                  For x7 = x8 To N
                    For x6 = x7 To N
                      For x5 = x6 To N
                        For x4 = x5 To N
                          For x3 = x4 To N
                            For x2 = x3 To N
                              For x1 = x2 To N
                                For x0 = x1 To N
                                  If Col(x14 + 1).Value > 0 And Col(x13 + 1).Value > 0 And Col(x12 + 1).Value > 0 And Col(x11 + 1).Value > 0 And Col(x10 + 1).Value > 0 And Col(x9 + 1).Value > 0 And Col(x8 + 1).Value > 0 And Col(x7 + 1).Value > 0 And Col(x6 + 1).Value > 0 And Col(x5 + 1).Value > 0 And Col(x4 + 1).Value > 0 And Col(x3 + 1).Value > 0 And Col(x2 + 1).Value > 0 And Col(x1 + 1).Value > 0 And Col(x0 + 1).Value > 0 And (Cible = 0 Or x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 + x13 + x14 = Cible) Then
                                    Table15(0, UBound(Table15, 2)) = "( " & x14 & " ; " & x13 & " ; " & x12 & " ; " & x11 & " ; " & x10 & " ; " & x9 & " ; " & x8 & " ; " & x7 & " ; " & x6 & " ; " & x5 & " ; " & x4 & " ; " & x3 & " ; " & x2 & " ; " & x1 & " ; " & x0 & " )"
                                    Table15(1, UBound(Table15, 2)) = Col(x0 + 1) * Col(x1 + 1) * Col(x2 + 1) * Col(x3 + 1) * Col(x4 + 1) * Col(x5 + 1) * Col(x6 + 1) * Col(x7 + 1) * Col(x8 + 1) * Col(x9 + 1) * Col(x10 + 1) * Col(x11 + 1) * Col(x12 + 1) * Col(x13 + 1) * Col(x14 + 1)
                                    Table15(2, UBound(Table15, 2)) = Fact(15) / CompteDoublons(Table15(0, UBound(Table15, 2)), Col)
                                    ReDim Preserve Table15(2, UBound(Table15, 2) + 1)
                                  End If
                                Next
                              Next
                            Next
                          Next
                        Next
                      Next
                    Next
                  Next
                Next
              Next
            Next
          Next
        Next
      Next
    Next
Je vais regarder pour mettre en place l'idée de ce matin, mais je ne vais pas avoir le temps à midi.
Pour l'histoire des tables que tu dois trainer jusqu'à la fin, je dirais que non, il suffit de garder en mémoire le critère qui t'intéresse, par exemple le tableau est il vide, oui - non, stocker ce type d'info ne tiens pas de place comparait a trainer un tableau rempli jusqu'à la fin uniquement pour savoir si celui ci est vide ou non. Mais ce n'est qu'un exemple il faut voir ce qu'il faut tiré du tableau exactement.
++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Score PowerBall Gyroscope Green : 11847
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/03/2010, 12h57   #14
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
Oui en effet, j'étais passé à côté de ton astuce, mais je viens de l'essayer ce matin et ça fonctionne Merci.

Petite parenthèse: j'avoue que je suis branché sur un jeu online, Final Fantasy XI, dont je développe d'ailleurs un outil Excel permettant de faire des choix d'équipements (une sorte de comparateur par calcul de dommages). J'ai d'ailleurs posté 2 autres topics sur ce forum à http://www.developpez.net/forums/d89...requentielles/ et http://www.developpez.net/forums/d88...lasseur-excel/

EDIT: Bon je poste la v4 modifiée avec les simplifications de boucle et des Destinations. Le constat est sans appel: pour un même calcul demandé, la version "simplifiée" est 10x plus .... lente que celle codée "en dur". No comprendo
Fichiers attachés
Type de fichier : zip Permutations conditionnelles - v4.1.zip (45,4 Ko, 2 affichages)

Dernière modification par Masamunai ; 15/03/2010 à 15h00.
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/03/2010, 13h06   #15
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 431
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 31
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 431
Points : 4 042
Points : 4 042
Envoyer un message via MSN à Qwazerty
Salut
Alors voila le principe

Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Function CalculProba(MaxN As Integer, NbrUplets As Integer)
'MaxN correspond a ton ancienne variable N
ReDim Xx(NbrUplets - 1) As Integer 'valeur de 0 à NbrUplet-1
Dim xDim As Integer
 
 
Do
 
'Traitement
        'If Col(x1 + 1).Value > 0 And Col(x0 + 1).Value > 0 And (Cible = 0 Or x0 + x1 = Cible) Then
        '  Table2(0, UBound(Table2, 2)) = "( " & x1 & " ; " & x0 & " )"
        '  Table2(1, UBound(Table2, 2)) = Col(x0 + 1) * Col(x1 + 1)
        '  Table2(2, UBound(Table2, 2)) = Fact(2) / CompteDoublons(Table2(0, UBound(Table2, 2)), Col)
        '  ReDim Preserve Table2(2, UBound(Table2, 2) + 1)
        'End If
'Code a remettre en forme, je le met ici pour l'explication
'Tableau2 sera remplacer par une variable tableau local qui sera ensuite retourné par la fonction CalculProba
 
    'Calcul des membres
    'On incremente le tableau de poid faible
    Xx(0) = Xx(0) + 1
    'On boucle du tableau de poid le plus haut jusqu'a tableau d'indice 1
    For xDim = NbrUplets - 1 To 1 Step -1
        'On regarde si le tableau inferieur est en bout de course (>MaxN)
        If Xx(xDim - 1) > MaxN Then
            Xx(xDim) = Xx(xDim) + 1
            Xx(xDim - 1) = Xx(xDim)
        End If
    Next
 
Loop While Xx(NbrUplets - 1) < MaxN 'provisoir
 
End Function
Il suffira d'appeler autant de fois que nécessaire cette fonction en lui passant comme paramètres
MaxN : correspondant a ton N dans ton code
NbrUplet : Nombre de boucle a réaliser (Avec ton ancien code pour un Uplets 3, tu avait 3 boucles for, ici la fonction reproduira tes 3 boucles for.
Si tu me dis que la boucle for précédente fonctionne, alors il y a de grandes chances que celle ci aussi.

Il reste à coder la parti remplissage du tableau et a l'intègrer dans ton code d'origine.

A++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Score PowerBall Gyroscope Green : 11847
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/03/2010, 15h08   #16
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
o.O je n'avais pas vu 2e page lol

Ok merci beaucoup, je vais regarder ça tout de suite.

Edit: bon... après lecture de cette explication... je reste sceptique pour les raisons suivanes:
a) ce n'est pas NbrUplets, mais NbMembres (sous-entendu max par uplet). S'il y en a 15 demandés, ce que le dernier type d'uplet sera de type à 15 chiffres. Rien à voir avec le dénombrement d'uplets. Dans le code, ce Nbmembres est noté NbM (et cNbM pour NbM corrigé pour l'anti-saturation)
b) Pourquoi faire "à l'envers" ? surtout si on doit afficher les résultats des uplets générés au fur et à mesure ce serait 10x mieux (et + lisible) de commencer par les uplets de poids faible, puis monter en puissance ? et aussi pour des raisons de test d'arrêt non ?
Ces deux raisons font que je pense que je devrais te laisser le temps de bien assimiler les choses (peut être as-tu zappé trop de détails ?)

En revanche, l'idée de mettre tous les x0, x1, x2, ... , xN de ces boucles dans un tableau intermédiaire qui serait appelé à chaque appel de la fonction, puis redimensionné correctement, avant d'attaquer le "traitement" proprement dit, me semble pas mal du tout

Dernière modification par Masamunai ; 15/03/2010 à 16h31.
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/03/2010, 22h23   #17
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 431
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 31
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 431
Points : 4 042
Points : 4 042
Envoyer un message via MSN à Qwazerty
Salut
Voila un code qui reproduit les même résultat que le tien.
Par contre un bug apparait a partir de 63 Membres, je m'y pencherais peut être plus tard.
Bon teste
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
Option Explicit
 
Function Fact(Nombre) As Double
Dim Boucle As Integer
Fact = 1
If Int(Nombre) >= 2 Then
  For Boucle = 2 To Int(Nombre)
    Fact = Fact * Boucle
  Next Boucle
End If
End Function
 
Function CompteDoublons(Uplet, Col) ' Comptage du nombre de répetitions NbR pour chacun des membres de l'uplet
    Dim i, C As Integer
    Dim NbR As Integer
 
    CompteDoublons = 1
    For i = 0 To 8
        NbR = 0
        If Col(i) > 0 Then
            NbR = Len(Uplet) - Len(Replace(Uplet, i, ""))
        End If
        CompteDoublons = CompteDoublons * Fact(NbR)
    Next
 
End Function
 
Function CalculProba(MaxN As Integer, NbrMembres As Integer, ByRef Col() As Single, Cible As Integer)
'MaxN correspond a ton ancienne variable N
ReDim Xx(NbrMembres - 1) As Integer 'valeur de 0 à NbrMembres-1
Dim xDim As Integer
Dim SomX As Integer
Dim bPositif As Boolean
Dim sCol As Single
ReDim Tab_vTmp(NbrMembres - 1) As String
ReDim Tab_Retour(2, 0) As Variant
 
 
    'Initialisation
    CalculProba = False
 
    Do
        'Traitement
        'On control que tous les membres de col soit > 0
        bPositif = True
        SomX = 0
        sCol = 1
        For xDim = 0 To NbrMembres - 1
            If Col(Xx(xDim)) <= 0 Then
                bPositif = False
                Exit For
            End If
            SomX = SomX + Xx(xDim)
            sCol = sCol * Col(Xx(xDim))
        Next
 
        If bPositif And (Cible = 0 Or SomX = Cible) Then
            For xDim = 0 To UBound(Xx)
                Tab_vTmp(xDim) = CStr(Xx(xDim))
            Next
            Tab_Retour(0, UBound(Tab_Retour, 2)) = "( " & Join(Tab_vTmp, " ; ") & " )"
            Tab_Retour(1, UBound(Tab_Retour, 2)) = sCol
            Tab_Retour(2, UBound(Tab_Retour, 2)) = Fact(NbrMembres) / CompteDoublons(Tab_Retour(0, UBound(Tab_Retour, 2)), Col)
            CalculProba = Tab_Retour
            ReDim Preserve Tab_Retour(2, UBound(Tab_Retour, 2) + 1)
        End If
 
        'Calcul des membres
        'On incremente le tableau de poid fort
        Xx(NbrMembres - 1) = Xx(NbrMembres - 1) + 1
        'On boucle du tableau de poid le plus faible jusqu'a tableau d'indice NbrMembres-1
        For xDim = NbrMembres - 1 To 1 Step -1
            If Xx(xDim) > MaxN Then Xx(xDim - 1) = Xx(xDim - 1) + 1
        Next
        For xDim = 1 To NbrMembres - 1
            If Xx(xDim) > MaxN Then Xx(xDim) = Xx(xDim - 1)
        Next
    Loop While Xx(0) <= MaxN
 
End Function
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
'Declaration
Dim xDest As Integer
Dim Tab_Result As Variant
Dim bVide As Boolean
 
Dim Cible As Integer, NbM As Integer, cNbM As Integer
Dim x As Integer, N As Integer, R As Integer
 
    'On verifie les conditions d'execution
    If Intersect(Target, Union([Data], [NbMembres], [SomCible])) Is Nothing Then Exit Sub
    If Intersect(Target, Union([Data], [NbMembres], [SomCible])).Cells.Count <> 1 Then
        MsgBox "Vous ne devez pas modifier simultanément le contenu de plusieurs cellules bleues" & vbCrLf & "Les calculs n'ont pas été effectués."
        Exit Sub
    End If
 
    'Initialisation
    Cible = [SomCible].Value
    NbM = [NbMembres].Value
    ReDim Col([Data].Cells.Count - 1) As Single
    R = 0
 
    For x = 1 To [Data].Cells.Count
      Col(x - 1) = [Data].Cells(x).Value2
      If [Data].Cells(x) > 0 Then
        N = x - 1 'Nbre maxi correspondant à la dernière donnée non-nulle
        R = R + 1 'Nbre réel de données non nulles (sans celles nulles avant N)
      End If
    Next x
 
    If Not 2 <= (UBound(Col) - 1) <= 9 Then
        MsgBox "Le Nombre de Probabilité(s) Différente(s) de Zéro n'est pas correct"
        Exit Sub
    End If
    If 1 > NbM Then
        MsgBox "Le Nombre de Membres doit être un Entier superieur a 1"
        Exit Sub
    End If
 
    'Cette partie du code n'etait valable que pour les versions precedant Excel 2007, qui gere plus de 2M de lignes (Integer avant et maintenant Long)
    'Je l'ai rend independante de la version d'excel
    x = 0
    While Fact(R + x) / (Fact(x) * Fact(R)) < (Rows.Count - 1) And x <= NbM 'Protection anti-saturation
        cNbM = x 'Nbre de membres max/uplet corrigé
        x = x + 1
    Wend
 
    ReDim DestRange(2 To cNbM) As Range 'a rendre polyvalent
 
    For xDest = 2 To cNbM 'a rendre polyvalent
        Set DestRange(xDest) = Cells(2, (xDest - 2) * 3 + 12)
    Next
 
    Application.EnableEvents = False
    [Results].Cells.ClearContents
    Application.EnableEvents = True
 
    'Traitement
    'On empeche la mise a jour a l'ecran
    Application.ScreenUpdating = False
    bVide = True
 
    'On boucle en fonction du nombre de membre
    For x = 2 To cNbM 'a rendre polyvalent
        Tab_Result = CalculProba(N, x, Col, Cible)
        If IsArray(Tab_Result) Then
            bVide = False
            Application.EnableEvents = False
            DestRange(x).Resize(UBound(Tab_Result, 2) + 1, 3) = WorksheetFunction.Transpose(Tab_Result)
            Application.EnableEvents = True
        End If
    Next
 
    'On verifie qu'il y a des resultats sinon on vide tout et on quitte
    If bVide Then
        MsgBox "Aucune permutation ne répond à votre critère de somme (" & Cible & ")"
        Application.EnableEvents = False
        [Results].Cells.ClearContents
        Application.EnableEvents = True
        Exit Sub
    End If
 
    Application.ScreenUpdating = True
 
    If cNbM < NbM Then
      MsgBox "Les permutations " & cNbM + 1 & "-uplets à " & NbM & "-uplets répondant à votre critère de somme (" & Cible & ") n'ont pas été calculés car plus de 65000 possibilités."
    End If
 
End Sub
Par contre je me demande si ton algo de départ est correct, la colonne NbrPermute indique quoi exactement? si c'est le nombre de solution que l'on doit trouver dans le tableau, les valeurs ne correspondent pas.
a++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Score PowerBall Gyroscope Green : 11847
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/03/2010, 00h27   #18
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
Oui l'algo de départ était correct:

La simulation envoie simultanément les probas individuelles de chaque chiffre possible "0" "1" ... "8" (la somme de ces probas faisant toujours 100%), ainsi que l'objectif à atteindre SommeCible.

Du coup, la somme des probas générées par la macro dans chacune des 2e colonnes de chaque type de Xuplet doit être égale à 100% (si on les génére tous). Cette somme se voit dans la colonne à côté de Nbpermut dans le tableau résultats.

Or 1er test que j'ai fait est de taper SommeCible=0, et là tiens: à partir des 4uplets et au delà, la somme de ne fait plus 100% mais 100,0000X% X augmentant régulièrement, donc doit y avoir une combinaison de trop générée par ta macro.

En revanche, et surtout quand je commencais à avoir des doutes si tu y arriverais vu que tes posts précédents semblaient avoir zappé la moitié de mes explications, j'avoue je suis baba devant ce bout de code: robuste et rapide semble parfait

Quant au bug pour les 63uplets je peut te rassurer tout de suite :
la simulation n'ira jamais jusque là. Personnellement, je pense que cela vient de la limite en colonnes d'Excel2003 (63*3colonnes + la 15zaine du début ~ 210 colonnes déjà). Peut être que je me trompe mais bon ce n'est pas très grave.

Je regarderai demain plus en détail comment tu as fait cette perle et jessaierai de trouver la combinaison "en trop". D'ailleurs pour répondre à ta question: NbPermut a un commentaire, il y a aussi une formule dans les cells et au moins 3 posts expliquant qu'on ne génére pas toutes les permutations souhaitées, mais des combinaisons avec répétitions x nb permutations simples à partir de ces combinaisons cette colonne NbPermut me servait surtout à verifier qu'on obtenait bien le bon nombre total souhaité.

@ ++
Masa
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/03/2010, 12h28   #19
Invité régulier
 
Inscription : août 2009
Messages : 140
Détails du profil
Informations forums :
Inscription : août 2009
Messages : 140
Points : 9
Points : 9
Bonjour,

Bon après avoir passé la matinée à essayer de comprendre la fonction CalculProba, il en ressort pas mal de questions, mais je ne poserai que les principales pour l'instant:

1. Pourquoi faire le contrôle des probas individuelles non nulles dans une boucle à part ? Dans l'algo de départ j'avais réussi à mettre à la fois Tab_vTmp, SomX et sCol dans la même boucle For et le même If, serait pas possible dans ta fonction ?

2. Je crois avoir trouvé d'où proviennent les décimales "en trop" détectées lors du test hier soir:
la ligne sCol = sCol * Col(Xx(xDim)), avec Col(Xx(xDim)) et sCol de type Single

Au 1er bouclage (xDim=0, pour l'uplet (0;0)), chacun des éléments avant la multiplication contient:
Col(Xx(xDim))=0.055 (proba 5.5% pour le chiffre "0") -> OK
sCol=1 (suite à l'initialisation à 100%) -> OK
puis le résultat de la multiplication, de type single aussi donnera à la boucle suivante :
Col(Xx(xDim))=0.055 (proba 5.5% pour le chiffre "0" de nouveau) -> OK
sCol=0.055 (résultat boucle précédente) -> OK
sCol (Résultat) = 0,00302500000 -> OK
... puis pour l'uplet (0;1) :
Col(Xx(xDim))=0.54 (proba 54% pour le chiffre "1") -> OK
sCol= 0,055 (résultat boucle précédente) -> OK
sCol (Résultat) = 0,0297000017 -> PAS OK !

Résultat après sommation de toutes ces probas multipliées on obtient non pas pile poil 100% mais 100,0000031%.
En comparaison, dans l'algo original, cette multiplication se faisait directement, et ne donne pas ces décimales parasites... càd un beau 100% tout rond même en rajoutant 1000 décimales derrière la virgule sont toutes à 0.
Ma calculette donne aussi .0297, aucune trace de ce 17 "parasite".

En termes de solution pas contre, je vois pas comment régler ça...

@++
Masamunai est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/03/2010, 18h54   #20
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 431
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 31
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 431
Points : 4 042
Points : 4 042
Envoyer un message via MSN à Qwazerty
Salut
Citation:
Envoyé par Masamunai Voir le message
1. Pourquoi faire le contrôle des probas individuelles non nulles dans une boucle à part ? Dans l'algo de départ j'avais réussi à mettre à la fois Tab_vTmp, SomX et sCol dans la même boucle For et le même If, serait pas possible dans ta fonction ?
Désolé je ne vois pas de quelle patrie du code tu parles, peux tu mettre un extrait de code

Citation:
Envoyé par Masamunai Voir le message
2. Je crois avoir trouvé d'où proviennent les décimales "en trop" détectées lors du test hier soir:
la ligne sCol = sCol * Col(Xx(xDim)), avec Col(Xx(xDim)) et sCol de type Single
Alors en effet ces variables sont de type Single, si tu veux une précision au delà, utilise des Double. Juste une chose a se sujet, il faut quand on fait (ou fait faire) un code, garder en tête ce que l'on souhaite obtenir a la fin, ici de quelle précision a tu besoin? utiliser des Double a la place des Single alourdi l'utilisation des ressources du PC alors pour éviter une "erreur" de 1 pour 100000 est ce vraiment judicieux?
Si tu souhaites une telle précision utilise des Double et si tu veux juste un jolie compte rond, arrondi la valeur à 2 ou 3 ou ... ou 6 décimales après la virgule.

Citation:
Envoyé par Masamunai Voir le message
Ma calculette donne aussi .0297, aucune trace de ce 17 "parasite".
Normal ici on "arrondi" la valeur de chaque composantes de la multiplication par rapport au type Single, pas ta calculette.
Dis moi si les Double corresponde a ton besoin de précision.

Une dernière chose par rapport a la précision des calcules, vérifie le nombre de décimales conservé dans une cellule par excel on est très loin du type Double.

A++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Score PowerBall Gyroscope Green : 11847
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité Cette discussion est résolue.
Outils de la discussion



Fuseau horaire GMT +1. Il est actuellement 07h42.


 
 
 
 
Partenaires

Hébergement Web