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

    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
  2. Bonjour , et un grand merci via55 !

    Problème Résolu !
    0