IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Simplification de boucles FOR avec concaténation ? [Toutes versions]


Sujet :

Macros et VBA Excel

  1. #1
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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.

  2. #2
    Membre émérite
    Profil pro
    Inscrit en
    Juillet 2007
    Messages
    2 130
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2007
    Messages : 2 130
    Points : 2 443
    Points
    2 443
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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+

  3. #3
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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)

  4. #4
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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....

    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
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  5. #5
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    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)

  6. #6
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    Re
    Pour le debut
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  7. #7
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    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) )

  8. #8
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  9. #9
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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.

  10. #10
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    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
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  11. #11
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    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:
    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

  12. #12
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    En attendant ce soir j'ai essayé d'appliquer tes conseils de syntaxe :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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.

  13. #13
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  14. #14
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    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 Fichiers attachés

  15. #15
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    Salut
    Alors voila le principe

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  16. #16
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    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

  17. #17
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  18. #18
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    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

  19. #19
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Août 2009
    Messages
    140
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2009
    Messages : 140
    Points : 37
    Points
    37
    Par défaut
    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...

    @++

  20. #20
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    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
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

+ Répondre à la discussion
Cette discussion est résolue.
Page 1 sur 2 12 DernièreDernière

Discussions similaires

  1. Boucle for et concaténation
    Par mulbek dans le forum Langage
    Réponses: 4
    Dernier message: 13/12/2010, 13h38
  2. Boucle for avec saut
    Par michel71 dans le forum Delphi
    Réponses: 3
    Dernier message: 25/02/2007, 16h16
  3. boucle for avec condition
    Par Daniel Magron dans le forum Delphi
    Réponses: 4
    Dernier message: 22/01/2007, 16h18
  4. Réponses: 2
    Dernier message: 28/08/2006, 18h17
  5. [VB6] boucle for avec liste de valeur defini
    Par Morpheus2144 dans le forum VB 6 et antérieur
    Réponses: 3
    Dernier message: 06/04/2006, 18h12

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo