Calcul de combinaisons: Analyse de risque .

Résolu
Bonjour je travaille sur une analyse de risque, le principe est relativemement simple, j'ai 7 critères (7 colonnes) . Chaque critère a des niveaux différents auxquels sont attribués des notes différentes (ex critère Source: Animale =4 Végétale=2 minérale=1 )

La difficulté étant pouvoir sortir tous les combinaisons possible sachant que certains critères ont 3 Niveaux et d'autres 5 niveaux ou encore jusqu'a 7 niveaux ... et la je sèche.

Si quelqu'un à une idée ou connait une formule ?

Merci d'avance,

Hadrien

2 réponses

  1. Bonjour , et un grand merci via55 !

    Problème Résolu !
    0
    1. Bonjour

      Une possibilité par macro :
      En supposant les critères dans les colonnes A à G de la feuille1 avec une ligne de titres et les niveaux commençant en ligne 2
      Toutes les combinaisons sont listées en feuille 2
      Selon le nombre de combinaisons la macro peut mettre un certain temps à s'exécuter
      ALT+F11 pour ouvrir l'editeur VBA puis Insertion - Module, copier-coller la macro dans le module et fermer l'éditeur
      Pour lancer la macro depuis la feuille onglet Developpeur puis Macros
      Sub combinaisons()
      na = Application.WorksheetFunction.CountA(Sheets(1).Range("A:A"))
      nb = Application.WorksheetFunction.CountA(Sheets(1).Range("B:B"))
      nc = Application.WorksheetFunction.CountA(Sheets(1).Range("C:C"))
      nd = Application.WorksheetFunction.CountA(Sheets(1).Range("D:D"))
      ne = Application.WorksheetFunction.CountA(Sheets(1).Range("E:E"))
      nf = Application.WorksheetFunction.CountA(Sheets(1).Range("F:F"))
      ng = Application.WorksheetFunction.CountA(Sheets(1).Range("G:g"))
      Application.DisplayAlerts = False
      For a = 2 To na
      For b = 2 To nb
      For c = 2 To nc
      For d = 2 To na
      For e = 2 To ne
      For f = 2 To nf
      For g = 2 To ng
      x = x + 1
      Sheets(2).Cells(x, 1) = Sheets(1).Cells(a, 1)
      Sheets(2).Cells(x, 2) = Sheets(1).Cells(b, 2)
      Sheets(2).Cells(x, 3) = Sheets(1).Cells(c, 3)
      Sheets(2).Cells(x, 4) = Sheets(1).Cells(d, 4)
      Sheets(2).Cells(x, 5) = Sheets(1).Cells(e, 5)
      Sheets(2).Cells(x, 6) = Sheets(1).Cells(f, 6)
      Sheets(2).Cells(x, 7) = Sheets(1).Cells(g, 7)
      Next g
      Next f
      Next e
      Next d
      Next c
      Next b
      Next a
      Application.DisplayAlerts = True
      End Sub


      Cdmnt
      Via
      1
      1. Bonjour via55

        attention à la boucle sur d. Il y a un copier/coller qui a du déraper.

        cdlt
        0
      2. Bonjour,

        Pour accélérer la procédure de via55, on peut utiliser les tableaux.
        Dans l'exemple que j'ai utilisé (7,5,5,3,5,3,7) et sur mon matériel, on passe de 50s à 6s.
        Option Base 1
        Sub combinaisons_accélérées()
        Dim result()
        na = Application.WorksheetFunction.CountA(Sheets(1).Range("A:A"))
        nb = Application.WorksheetFunction.CountA(Sheets(1).Range("B:B"))
        nc = Application.WorksheetFunction.CountA(Sheets(1).Range("C:C"))
        nd = Application.WorksheetFunction.CountA(Sheets(1).Range("D:D"))
        ne = Application.WorksheetFunction.CountA(Sheets(1).Range("E:E"))
        nf = Application.WorksheetFunction.CountA(Sheets(1).Range("F:F"))
        ng = Application.WorksheetFunction.CountA(Sheets(1).Range("G:g"))
        Set données = Sheets(1).Range("A1").Resize(Application.WorksheetFunction.Max(na, nb, nc, nd, ne, nf, ng), 7)
        ReDim result(na * nb * nc * nd * ne * nf * ng, 7)
        For a = 2 To na
        For b = 2 To nb
        For c = 2 To nc
        For d = 2 To nd
        For e = 2 To ne
        For f = 2 To nf
        For g = 2 To ng
        x = x + 1
        result(x, 1) = données(a, 1)
        result(x, 2) = données(b, 2)
        result(x, 3) = données(c, 3)
        result(x, 4) = données(d, 4)
        result(x, 5) = données(e, 5)
        result(x, 6) = données(f, 6)
        result(x, 7) = données(g, 7)
        Next g
        Next f
        Next e
        Next d
        Next c
        Next b
        Next a
        Sheets(2).Range("A1").Resize(x, 7) = result
        End Sub


        cordialement
        0
      3. Bonjour JvDo

        Bien vu !
        0