Creation d'une matrice de notation en marché public

Le 13/08/2024 à 22:51

Bonjour,

Je cherche à réaliser une matrice de notation des appels d'offre utile dans mon métier d'acheteur public. Le principe consiste à créer une feuille ou onglet qui est configurée pour afficher des critères de choix qui se ventilent en sous critères, eux mêmes pondérés selon des points et qui affiche des colonnes correspondantes au nombre de candidats qui ont répondu à l'appel d'offre. Bref cette première partie, j'ai réussi à la réaliser avec l'aide d'une A.I. Donc cela fonctionne !. Par contre, le problème devient insoluble lorsque je souhaite dupliquer l'onglet ou feuil2 en plusieurs onglets ou lots avec une configuration de ces onglets différentes de la Feuil2 qui a servi de modèle. En fait, la matrice intitulée "Sub CreerMatriceNotation(ws As Worksheet)" ne s'exécute pas sur les nouveaux onglets ou lots crées ?. J'ai essayé pas mal de possibilités, sans succès :-(... Bref, je fais appel à quelqu'un d'expert en VBA qui pourrait me donner un coup de main pour finaliser la macro et la faire fonctionner, étant certain que je touche au but

37matrice-n1-criteres-et-sous-criteres.xlsm (51.37 Ko)

. Merci par avance pour votre aide !! :-)

Le 14/08/2024 à 07:06

Bonjour,

Votre problème vient du fait que vous supprimez la feuille que vous venez de créer avant d'en créer une autre "

wsNew.Delete

j'ai mis cette ligne en remarque dans le code.

******************************************************************************************************************************************************

Voici votre code modifié, j'ai aussi incorporé une macro pour supprimer toutes les feuilles "Lot N° " existantes dès le lancement de la macro de création des lots.

Toutes les macros du module 1:

    Dim wsSource As Worksheet
    Dim wsNew As Worksheet

Sub CreerMatriceNotation(wsNew As Worksheet)
    Dim nombreCriteres As Integer
    Dim nombreSousCriteres As Integer
    Dim nombreCandidats As Integer
    Dim i As Integer, j As Integer, k As Integer
    Dim ligneDepart As Integer
    Dim colonneDepart As Integer
    Dim message As String
    Dim erreur As Boolean

    erreur = False
    message = "Veuillez corriger les erreurs suivantes :" & vbCrLf

    ' Récupérer le nombre de critères
    nombreCriteres = wsNew.Range("B2").Value

    ' Récupérer le nombre de candidats
    nombreCandidats = wsNew.Range("E2").Value

    ' Vérifier les sous-critères et les pondérations
    For i = 1 To nombreCriteres
        If wsNew.Cells(i + 1, 3).Value = "" Then
            erreur = True
            message = message & "- Le critère " & i & " n'a pas de sous-critères définis." & vbCrLf
        End If
        If wsNew.Cells(i + 1, 4).Value = "" Then
            erreur = True
            message = message & "- Le critère " & i & " n'a pas de pondération définie." & vbCrLf
        End If
    Next i

    ' Afficher un message d'avertissement si des erreurs sont détectées
    If erreur Then
        MsgBox message, vbExclamation, "Erreur de Saisie"
        Exit Sub
    End If

    ' Si tout est correct, continuer avec la création de la matrice
    ligneDepart = 15 ' Commence à la ligne 15 pour les réponses
    colonneDepart = 4 ' Colonne D pour la première colonne de réponse prestataire

    ' Effacer les anciennes données
    wsNew.Range("A12:Z100").Clear

    ' Ajouter les en-têtes pour chaque candidat
    For k = 0 To nombreCandidats - 1
        wsNew.Cells(14, colonneDepart + 3 * k).Value = "Réponse Prestataire " & (k + 1)
        wsNew.Cells(14, colonneDepart + 3 * k + 1).Value = "Commentaire Client Interne " & (k + 1)
        wsNew.Cells(14, colonneDepart + 3 * k + 2).Value = "Notation " & (k + 1)
    Next k

    ' Boucle pour ajouter les critères et sous-critères
    For i = 1 To nombreCriteres
        ' Indiquer le critère
        wsNew.Cells(ligneDepart, 1).Value = "Critère " & i

        ' Récupérer le nombre de sous-critères pour chaque critère
        nombreSousCriteres = wsNew.Cells(i + 1, 3).Value

        For j = 1 To nombreSousCriteres
            wsNew.Cells(ligneDepart + j, 2).Value = "Sous-Critère " & i & "." & j

            ' Appliquer la validation des données pour la notation pour chaque candidat
            For k = 0 To nombreCandidats - 1
                With wsNew.Cells(ligneDepart + j, colonneDepart + 3 * k + 2).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="1,2,3,4"
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .ShowInput = True
                    .ShowError = True
                End With
            Next k
        Next j

        ' Ajouter une ligne de totalisation pondérée pour chaque candidat
        For k = 0 To nombreCandidats - 1
            Dim totalCell As Range
            Set totalCell = wsNew.Cells(ligneDepart + nombreSousCriteres + 1, colonneDepart + 3 * k + 2)
            wsNew.Cells(ligneDepart + nombreSousCriteres + 1, colonneDepart + 3 * k + 1).Value = "Total Critère " & i
            totalCell.Formula = "=SUM(" & wsNew.Cells(ligneDepart + 1, colonneDepart + 3 * k + 2).Address & ":" & wsNew.Cells(ligneDepart + nombreSousCriteres, colonneDepart + 3 * k + 2).Address & ") / (" & nombreSousCriteres & " * 4) * " & wsNew.Cells(i + 1, 4).Value
        Next k

        ' Passer à la ligne suivante pour le prochain critère
        ligneDepart = ligneDepart + nombreSousCriteres + 2 ' Laisser une ligne vide entre les critères
    Next i
End Sub

Sub CreerOngletsEtExecuterMacro()
    Dim nombreLots As Integer
    Dim i As Integer

    Application.ScreenUpdating = False

    Suppression_des_onglets_Lot 'suppression des onglets "Lot" existants

    ' Définir la feuille source
    Set wsSource = ThisWorkbook.Sheets("Feuil2")

    ' Récupérer le nombre de lots à partir de la cellule F2
    nombreLots = wsSource.Range("F2").Value

    ' Boucle pour créer des copies de Feuil1 pour chaque lot
    For i = 1 To nombreLots
        ' Vérifier si l'onglet existe déjà, si oui, le supprimer
        On Error Resume Next
        Set wsNew = ThisWorkbook.Sheets("Lot N°" & i)
        If Not wsNew Is Nothing Then
            Application.DisplayAlerts = False
            'wsNew.Delete
            Application.DisplayAlerts = True
        End If
        On Error GoTo 0

        ' Copier Feuil1
        wsSource.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Set wsNew = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        wsNew.Name = "Lot N°" & i

        ' Exécuter la macro sur le nouvel onglet
        CreerMatriceNotation wsNew ' Appel direct de la macro
    Next i
End Sub

Sub Suppression_des_onglets_Lot()
    Application.DisplayAlerts = False
    For i = Sheets.Count To 1 Step -1
        If Left(Sheets(i).Name, 3) = "Lot" Then Sheets(i).Delete
    Next i
End Sub

Sub CreerMatriceNotationLot(ws As Worksheet)
    ' Exemple de code à exécuter sur chaque nouvel onglet
    wsNew.Range("A1").Value = "Exécution réussie sur " & wsNew.Name
    ' Ajoutez ici le code spécifique que vous souhaitez exécuter
End Sub

Cdlt

Le 14/08/2024 à 21:48

Mille merci pour votre réponse qui apporte une solution à la création des lots !. Cependant, il reste le problème de la configuration des onglets ou de chacun des lots qui doit exécuter la macro de configuration de manière distincte. Je m'explique : les paramètres définis en cellules B1 "Critères", C1 " SOUS CRITERES"; D1 " PONDERATION CRITERE", E1 "CANDIDAT" sont propres à chacun des lots crées et sont censés exécutés ou définir le contenu de la page du lot désigné. Exemple : Lot N°2 crée aura 3 critères définis en cellule B2 et 2 sous critères en cellules C2 et C3 , 2 pondérations pour chacun des sous-critères de "10" et de "15" définis en D2 et D3, un nombre de candidat de 5 en cellule E2. Le lot N°3 aura 2 critères, 4 sous critères, 4 pondérations associées à ces sous critères et un nombre de candidats de 3. On neutralise le nombre de lot défini en F2 qui ne doit plus être activé ici car le nombre de lots requis est déjà défini. En fait, la macro intitulée "Sub CreerMatriceNotation(wsNew As Worksheet)" doit s'exécuter de manière unique sur chacun des lots crées précédemment.. Voilà, ce n'est pas simple, je ne suis pas un spécialiste des macros, mais sais en tant qu'acheteur rédiger le cahier des charges du résultat à obtenir. Encore Merci pour votre aide, vraiment c'est très appréciable !!

Le 16/08/2024 à 06:35

Bonjour,

Pas sûr d'avoir tout compris, voici quand même une proposition, si cela ne correspond pas à vos attentes, joindre un fichier avec le résultat attendu.

27richard-magnien-creation-d-une-matrice-de-notation-en-marche-public-1.xlsm (30.77 Ko)

CDlt

Le 16/08/2024 à 22:51

Bonjour Arturo,

Suite à la présentation .PPT que j'ai été obligé de convertir en .jpg , voici la macro en question qui génère une erreur exprimée dans la slide ci dessus.

C'est vraiment super de pouvoir compter sur votre aide, je vous en remercie. J'espère avoir été clair sur les étapes de création d'une matrice de notation à laquelle je pense depuis de nombreuses années. J'espère y parvenir avec votre concours.

Sub CreerEtConfigurerLots()

Dim wsSource As Worksheet

Dim wsNew As Worksheet

Dim nombreLots As Integer

Dim i As Integer

' Définir la feuille source

Set wsSource = ThisWorkbook.Sheets("Feuil2") ' Assurez-vous que le nom est correct

' Récupérer le nombre de lots à partir de la cellule F5

nombreLots = wsSource.Range("F5").Value

' Boucle pour créer des copies de Feuil2 pour chaque lot

For i = 1 To nombreLots

' Vérifier si l'onglet existe déjà, si oui, le supprimer

On Error Resume Next

Set wsNew = ThisWorkbook.Sheets("Lot No" & i)

If Not wsNew Is Nothing Then

Application.DisplayAlerts = False

wsNew.Delete

Application.DisplayAlerts = True

End If

On Error GoTo 0

' Copier Feuil2

wsSource.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

Set wsNew = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

wsNew.Name = "Lot No" & i

' Effacer les cellules F1 et F2 dans le nouvel onglet

wsNew.Range("F1:F5").ClearContents

' Configurer le lot

ConfigurerLot wsNew

Next i

End Sub

Utiliser la macro ConfigurerLot(ws As Worksheet) pour configurer chaque lot :

Sub ConfigurerLot(ws As Worksheet)

Dim nombreCriteres As Integer

Dim nombreSousCriteres As Integer

Dim nombreCandidats As Integer

Dim i As Integer, j As Integer, k As Integer

Dim ligneDepart As Integer

Dim colonneDepart As Integer

' Récupérer le nombre de critères et de candidats

nombreCriteres = ws.Range("B2").Value

nombreCandidats = ws.Range("E2").Value

' Configurer la matrice

ligneDepart = 15

colonneDepart = 4

' Effacer les anciennes données

ws.Range("A12:Z100").Clear

' Ajouter les en-têtes pour chaque candidat

For k = 0 To nombreCandidats - 1

ws.Cells(14, colonneDepart + 3 * k).Value = "Réponse Prestataire " & (k + 1)

ws.Cells(14, colonneDepart + 3 * k + 1).Value = "Commentaire Client Interne " & (k + 1)

ws.Cells(14, colonneDepart + 3 * k + 2).Value = "Notation " & (k + 1)

Next k

' Boucle pour ajouter les critères et sous-critères

For i = 1 To nombreCriteres

ws.Cells(ligneDepart, 1).Value = "Critère " & i

nombreSousCriteres = ws.Cells(i + 1, 3).Value

For j = 1 To nombreSousCriteres

ws.Cells(ligneDepart + j, 2).Value = "Sous-Critère " & i & "." & j

' Appliquer la validation des données pour la notation

For k = 0 To nombreCandidats - 1

With ws.Cells(ligneDepart + j, colonneDepart + 3 * k + 2).Validation

.Delete

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

xlBetween, Formula1:="1,2,3,4"

.IgnoreBlank = True

.InCellDropdown = True

.ShowInput = True

.ShowError = True

End With

Next k

Next j

' Ajouter une ligne de totalisation pondérée pour chaque candidat

For k = 0 To nombreCandidats - 1

Dim totalCell As Range

Set totalCell = ws.Cells(ligneDepart + nombreSousCriteres + 1, colonneDepart + 3 * k + 2)

ws.Cells(ligneDepart + nombreSousCriteres + 1, colonneDepart + 3 * k + 1).Value = "Total Critère " & i

totalCell.Formula = "=SUM(" & ws.Cells(ligneDepart + 1, colonneDepart + 3 * k + 2).Address & ":" & _ ws.Cells(ligneDepart + nombreSousCriteres, colonneDepart + 3 * k + 2).Address & _ ") / (" & nombreSousCriteres & " * 4) * " & ws.Cells(i + 1, 4).Value

Next k

ligneDepart = ligneDepart + nombreSousCriteres + 2

Next i

End Sub

Le 17/08/2024 à 21:24

J'ai progressé, mais j'expérimente toujours un problème d'affichage des lots crées :

Par exemple, j'indique en cellule "F2" de "FEUIL 1" le chiffre 3 qui
correspond à la création de 3 lots. La macro s'exécute et me demande le
nombre de candidats pour le 1er lot, je renseigne cette information,
puis, ensuite la macro ne fait pas apparaitre l'onglet lot N°1?, vient
ensuite le tour du 2nd lot, même question à laquelle je saisis le nombre
de candidats, et même chose, l'onglet N°2 n'est pas crée ?. Seul le lot
N°3 apparait le dernier , qui fait l'objet d'une création ? En pièce jointe le code complet.

Merci pour votre aide précieuse!.

Sub CreerEtConfigurerLots()
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim nombreLots As Integer
    Dim i As Integer
    Dim nombreCandidats As Integer

    ' Définir la feuille source
    Set wsSource = ThisWorkbook.Sheets("Feuil1") ' Assurez-vous que le nom est correct

    ' Récupérer le nombre de lots à partir de la cellule F2
    nombreLots = wsSource.Range("F2").Value

    ' Boucle pour créer des copies de Feuil2 pour chaque lot
    For i = 1 To nombreLots
        ' Vérifier si l'onglet existe déjà, si oui, le supprimer
        On Error Resume Next
        Set wsNew = ThisWorkbook.Sheets("Lot No" & i)
        If Not wsNew Is Nothing Then
            Application.DisplayAlerts = False
            wsNew.Delete
            Application.DisplayAlerts = True
        End If
        On Error GoTo 0

        ' Copier Feuil2
        wsSource.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Set wsNew = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        wsNew.Name = "Lot No" & i

        ' Effacer les cellules F1 et F2 dans le nouvel onglet
        wsNew.Range("F1:F5").ClearContents

        ' Demander le nombre de candidats pour ce lot
        nombreCandidats = Application.InputBox("Entrez le nombre de candidats pour le Lot No" & i, "Nombre de Candidats", Type:=1)

        ' Vérifier si l'utilisateur a annulé ou entré une valeur invalide
        If nombreCandidats <= 0 Then
            MsgBox "Nombre de candidats invalide. Le lot ne sera pas configuré.", vbExclamation
            wsNew.Delete  ' Supprimer l'onglet si le nombre de candidats est invalide
        Else
            ' Enregistrer le nombre de candidats dans la cellule E2
            wsNew.Range("E2").Value = nombreCandidats

            ' Configurer le lot
            ConfigurerLot wsNew
        End If
    Next i
End Sub

Sub ConfigurerLot(ws As Worksheet)
    Dim nombreCriteres As Integer
    Dim nombreSousCriteres As Integer
    Dim nombreCandidats As Integer
    Dim i As Integer, j As Integer, k As Integer
    Dim ligneDepart As Integer
    Dim colonneDepart As Integer

    ' Récupérer le nombre de critères et de candidats
    nombreCriteres = ws.Range("B2").Value
    nombreCandidats = ws.Range("E2").Value

    ' Configurer la matrice
    ligneDepart = 15
    colonneDepart = 4

    ' Effacer les anciennes données
    ws.Range("A12:Z100").Clear

    ' Ajouter les en-têtes pour chaque candidat
    For k = 0 To nombreCandidats - 1
        ws.Cells(14, colonneDepart + 3 * k).Value = "Réponse Prestataire " & (k + 1)
        ws.Cells(14, colonneDepart + 3 * k + 1).Value = "Commentaire Client Interne " & (k + 1)
        ws.Cells(14, colonneDepart + 3 * k + 2).Value = "Notation " & (k + 1)
    Next k

    ' Boucle pour ajouter les critères et sous-critères
    For i = 1 To nombreCriteres
        ws.Cells(ligneDepart, 1).Value = "Critère " & i
        nombreSousCriteres = ws.Cells(i + 1, 3).Value

        For j = 1 To nombreSousCriteres
            ws.Cells(ligneDepart + j, 2).Value = "Sous-Critère " & i & "." & j

            ' Appliquer la validation des données pour la notation pour chaque candidat
            For k = 0 To nombreCandidats - 1
                With ws.Cells(ligneDepart + j, colonneDepart + 3 * k + 2).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="1,2,3,4"
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .ShowInput = True
                    .ShowError = True
                End With
            Next k
        Next j

        ' Ajouter une ligne de totalisation pondérée pour chaque candidat
        For k = 0 To nombreCandidats - 1
            Dim totalCell As Range
            Set totalCell = ws.Cells(ligneDepart + nombreSousCriteres + 1, colonneDepart + 3 * k + 2)
            ws.Cells(ligneDepart + nombreSousCriteres + 1, colonneDepart + 3 * k + 1).Value = "Total Critère " & i
            totalCell.Formula = "=SUM(" & ws.Cells(ligneDepart + 1, colonneDepart + 3 * k + 2).Address & ":" & _
                                ws.Cells(ligneDepart + nombreSousCriteres, colonneDepart + 3 * k + 2).Address & _
                                ") / (" & nombreSousCriteres & " * 4) * " & ws.Cells(i + 1, 4).Value
        Next k

        ' Passer à la ligne suivante pour le prochain critère
        ligneDepart = ligneDepart + nombreSousCriteres + 2 ' Laisser une ligne vide entre les critères
    Next i
End Sub

Sub Suppression_des_onglets_Lot()
    Application.DisplayAlerts = False
    For i = Sheets.Count To 1 Step -1
        If Left(Sheets(i).Name, 3) = "Lot" Then Sheets(i).Delete
    Next i
End Sub

Le 20/08/2024 à 09:50

Ce message pour vous aviser que j'ai réussi à obtenir le résultat attendu, avec l'affichage de tous les lots requis sans suppression de ces derniers.

Suis très satisfait et vous remercie pour votre aide.

Très cordialement,

Richard

Rechercher des sujets similaires à "creation matrice notation marche public"