Calcul de combinaisons: Analyse de risque .

Résolu/Fermé
hadiboux Messages postés 2 Date d'inscription mardi 16 juin 2015 Statut Membre Dernière intervention 16 juin 2015 - 16 juin 2015 à 11:12
via55 Messages postés 14402 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 18 avril 2024 - 16 juin 2015 à 15:15
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 14402 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 18 avril 2024 2 702
16 juin 2015 à 13:29
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 mercredi 27 juillet 2005 Statut Membre Dernière intervention 28 septembre 2020 856
16 juin 2015 à 14:17
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 mercredi 27 juillet 2005 Statut Membre Dernière intervention 28 septembre 2020 856
16 juin 2015 à 15:03
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 14402 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 18 avril 2024 2 702
16 juin 2015 à 15:15
Bonjour JvDo

Bien vu !
0
hadiboux Messages postés 2 Date d'inscription mardi 16 juin 2015 Statut Membre Dernière intervention 16 juin 2015
16 juin 2015 à 14:02
Bonjour , et un grand merci via55 !

Problème Résolu !
0