Remplir une Matrice de Prouty

Bonjour à tous,

Dans le cadre d'un projet, nous devons afficher l'IdRsk de l'ensemble des risques dans une matrice de Prouty (4/4; Probabilité x Gravité).

Pour chaque Risque : ligne dans "Table3" onglet "RiskRegister", j'ai prévu un IdRsk afin de pouvoir le retrouver facilement.

Pour chaque Risque, en plus du produit Pb x Gravité, j'ai également une position dans la matrice de Prouty suivant cette image :

Je souhaiterai donc pouvoir dans ma matrice de "Prouty" et ma matrice de "Prouty Residuel" afficher dans chaque cellule la ou les références de risques qui sont issus de mon "Table3".

Je cherche donc a faire une macro qui :

• Vide les 2 matrices
• Indique le nombre de lignes dans "Table3" & indique le nombre de lignes à afficher suivant critère "Oui" dans colonne A de "Table3" dans un popup
• Remplit les 2 matrices (Prouty (Colonne L de "Table3") et Prouty Residuel (Colonne R de "Table3") avec l'IdRsk (Colonne D de "Table3) de chaque risque pour lequel il a été indiqué "Oui" dans (Colonne A - afficher dans Matrice; "Table3").

Exemple du résultat recherché :

Pour ceux qui peuvent me donner un coup de main, voici le fichier Excel de travail avec un bouton de lancement de la macro dans l'onglet RiskRegister.

Un grand merci à tous pour votre aide.

A mettre sur le bouton.

Sub toto()
    Dim dernlig As Integer, nbrisk As Integer, nbriskoui As Integer, i As Integer, j As Integer, k As Integer
    With Sheets("RiskRegister ")
        'dernière ligne des risques
        derlig = .Range("A8").End(xlDown).Row
        'nombre de risques
        nbrisk = derlig - 8
        'nombre de risques a afficher
        nbriskoui = Application.WorksheetFunction.CountIf(.Range("A9:A" & derlig), "=" & "Oui")
        MsgBox ("Nbr risques : " & nbrisk & " Nbr risques oui : " & nbriskoui)
        'vides les proutys
        Sheets("Prouty").Range("B5:E8").ClearContents
        Sheets("Prouty Residuel").Range("B5:E8").ClearContents
        'Replit prouty
        For i = 9 To derlig
            For j = 1 To 4
                For k = 4 To 1 Step -1
                    If .Range("A" & i) = "Oui" Then
                        If .Range("I" & i) = Sheets("Prouty").Cells(9, j + 1) And .Range("J" & i) = Sheets("Prouty").Cells(k + 4, 1) Then
                            Sheets("Prouty").Cells(k + 4, j + 1) = Sheets("Prouty").Cells(k + 4, j + 1) & " " & .Range("D" & i)
                        End If
                    End If
                Next k
            Next j
        Next i
        'Replit prouty résiduel
        For i = 9 To derlig
            For j = 1 To 4
                For k = 4 To 1 Step -1
                    If .Range("A" & i) = "Oui" Then
                        If .Range("O" & i) = Sheets("Prouty Residuel").Cells(9, j + 1) And .Range("P" & i) = Sheets("Prouty Residuel").Cells(k + 4, 1) Then
                            Sheets("Prouty Residuel").Cells(k + 4, j + 1) = Sheets("Prouty Residuel").Cells(k + 4, j + 1) & " " & .Range("D" & i)
                        End If
                    End If
                Next k
            Next j
        Next i
    End With
End Sub

Concernant la double cerise, vu qu'une case du tableau peut contenir plusieurs risques, il n'est pas possible d'établir un renvoi unique...

Maître...

Comme dire... Merci cela fonctionne à la perfection.

(Normal c'est moi qui l'ai fait...)

Bonjour,

Pouvez m'aider quant au report automatique de résultat ds ma matrice (peut être via un croisé dynamique)? Je n'arrive pas à trouver de solution pour reporter les résultats des colonnes M,P,S dans les feuilles respectives Matrice brute, pondérée, corrigée. est ce qu'il est possible d'avoir un effet nuage de point ou une lettre pour symboliser le scenario reporté?

merci de votre réponse

Damien (débutant)

J'utilise un PC en ce moment avec une version 2010.