Calcul de combinaisons: Analyse de risque .

Résolu
hadiboux Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -  
via55 Messages postés 14512 Date d'inscription   Statut Membre Dernière intervention   -
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
A voir également:

2 réponses

via55 Messages postés 14512 Date d'inscription   Statut Membre Dernière intervention   2 746
 
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
JvDo Messages postés 1978 Date d'inscription   Statut Membre Dernière intervention   859
 
Bonjour via55

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

cdlt
0
JvDo Messages postés 1978 Date d'inscription   Statut Membre Dernière intervention   859
 
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
via55 Messages postés 14512 Date d'inscription   Statut Membre Dernière intervention   2 746
 
Bonjour JvDo

Bien vu !
0
hadiboux Messages postés 2 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour , et un grand merci via55 !

Problème Résolu !
0