Gestion de la compatibilité de références

Bonjour,

Je cherche actuellement une solution pour gérer des compatibilités de référence. Après de multiples recherches sur internet, je n'ai rien trouvé. Je n'ai peut être pas le bon vocabulaire de recherche ? J'ai initialisé la macro, initialisé seulement parce étant débutant, je suis déjà bloqué. Vous trouverez le descriptif de ce que je veux faire en pièce jointe.

En résumé, je souhaite établir une cartographie des compatibilités entre références et en fonction de celle-ci, interdire des sélections.

J'espère que vous pourrez m'aider.

Bonjour,

est-ce que les références dites A possibles vont de 1 à 16 ou seulement de 1 à 8 ? idem pour référence "B" du reste ...

Bonjour Steelson,

Excusez-moi pour ma réponse tardive, je viens de voir la votre.

La liste des références va de Ref 1 à Ref 16. Ensuite je peux utiliser ces références dans la colonne "Référence A" ou "Référence B" pour indiquer des incompatibilités.

David

En effet, je ne suis pas sûr d'avoir tout compris.

1. il y a des références de ref1 à ref16 avec des désignations = ok
2. ensuite il y a des couples incompatibles (donc par 2) entre ces références, c'est bien cela ? exemple ref1 n'est pas compatible de ref5
3. enfin il y a un choix de 2 références je suppose
   1. la première prise sans contrainte mais une seule fois, c'est cela ?
   2. la seconde seulement
      1. si elle n'est pas incompatible ? c'est cela ?
      2. et seulement une seule fois ? c'est cela ?

Ce n'est effectivement pas simple à expliquer. Merci pour vos questions précises qui m'aident dans ce sens.

- Couples d'incompatibilités par 2 = oui ; mais parfois une référence peut être incompatible avec plusieurs autres.

- Exemple Ref 1 non compatible avec Ref 5

- On peut également avoir par exemple Ref 4 incompatible avec Ref 1

Colonne A // Colonne B

Ref 1 // Ref 5

Ref 4 // Ref 1

Ref 1 peut donc être dans la colonne A ou B.

- Si j'ai déjà sélectionné Ref 1 et que je veuille sélectionner Ref 5 => je voudrais un messagebox qui me dise "Ref 1 est incompatible avec Ref 4, Ref 5, Ref n et empêcher la sélection de Ref 5.

Ref n : si il y en a d'autres.

J'espère avoir bien expliqué ma demande...

Je cherche à faire cette macro pour des produits qui sont parfois incompatibles.

Merci par avance et bonne journée,

David

Une dernière question ... dans ta macro tu avais prévu la sélection par une croix en colonne A. Peut-il y avoir un nombre indéfini de croix et dans ce cas rechercher toutes les incompatibilités entre toutes les sélections ?

Première approche, les données sont structurées en tableaux

Private Sub Worksheet_Change(ByVal Target As Range)
Dim incompatible As Object

    If Application.Intersect(Target, Range("Tref[Choix]")) Is Nothing Then Exit Sub

    If Target.Rows.Count > 1 Then
        MsgBox "Une seule sélection à la fois !"
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If

    Data = Range("Tincompatible").Value
    Set incompatible = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Data)
        ' on met ici les couples maudits dans un dictionnaire
        incompatible(Data(i, 1) & "|" & Data(i, 3)) = ""
        incompatible(Data(i, 3) & "|" & Data(i, 1)) = ""
    Next

    Data = Range("Tref").Value
    ok = True: Message = ""
    For i = 1 To UBound(Data) - 1
        For j = i To UBound(Data)
            If Data(i, 3) <> "" And Data(j, 3) <> "" Then
                If incompatible.exists(Data(i, 1) & "|" & Data(j, 1)) Then
                    ok = False: Message = Message & vbCrLf & Data(i, 1) & " et " & Data(j, 1)
                End If
            End If
        Next
    Next

    If Not ok Then
        MsgBox "Incompatibilité détectée !" & vbCrLf & Message
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If

End Sub

Les croix seront placées après la définition des incompatibilités.

L'ensemble des croix présentes dans la colonne A doivent être vérifiée (compatibilité) au moment ou elles sont mises en place.

Oui, il peut y avoir un nombre indéfini de croix.

J'espère que je réponds correctement à votre question. Mais effectivement, rien ne sert de courir, il faut partir partir à point... Je travaille dans un bureau d'études et j'ai vu trop de fois des sujets mal définis au départ et ont mal terminés forcément. C'est d'ailleurs très bien illustré par ce dessin:

Merci beaucoup Steelson pour votre aide,

David

Je connais ce dessin et je connais des cas !

As-tu regardé la première maquette ?

Inconsciemment, j'ai dit tout fort "waouuuuuuh !" en testant la maquette ! Je suis vraiment impressionné ! C'est génial de pouvoir écrire ce que l'on veut de cette façon et aussi rapidement. J'y aurait passé 2 ans... Bravo Steelson !!

Deux dernières questions, c'est très bien que vous l'ayez réalisé en tableau parce que c'est justement ce que j'ai dans mon fichier initial. J'ai plusieurs tableau "source" identiques à celui-ci :

J'imagine qu'il est possible de faire une boucle pour éviter des recopies de code ? Pouvez-vous me dire comment faire ?

Dernière question, est-il possible de rapatrier facilement les désignations en plus des références dans le msgbox ?

Après ça, nous aurons atteint l'excellence !

Vous trouverez un exemple en piece jointe.

Je n'en reviens toujours pas de votre rapidité ! waouhhhh

David

Pas de soucis pour la désignation

Pour les tables multiples, il vaut mieux dans ce cas mettre les couples maudits sur un autre onglet.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim incompatible As Object

ok = False
For Each tbl In ActiveSheet.ListObjects
    If Not Application.Intersect(Target, tbl.ListColumns(3).DataBodyRange) Is Nothing Then ok = True: Exit For
Next

If ok Then

    If Target.Rows.Count > 1 Then
        MsgBox "Une seule sélection à la fois !"
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If

    Data = Sheets("incompatibilites").Range("Tincompatible").Value
    Set incompatible = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Data)
        ' on met ici les couples maudits dans un dictionnaire
        incompatible(Data(i, 1) & "|" & Data(i, 3)) = ""
        incompatible(Data(i, 3) & "|" & Data(i, 1)) = ""
    Next

    Data = tbl.DataBodyRange.Value
    ok = True: Message = ""
    For i = 1 To UBound(Data) - 1
        For J = i To UBound(Data)
            If Data(i, 3) <> "" And Data(J, 3) <> "" Then
                If incompatible.exists(Data(i, 1) & "|" & Data(J, 1)) Then
                    ok = False: Message = Message & vbCrLf & Data(i, 1) & " (" & Data(i, 2) & ") et " & Data(J, 1) & " (" & Data(J, 2) & ")"
                End If
            End If
        Next
    Next

    If Not ok Then
        MsgBox "Incompatibilité détectée !" & vbCrLf & Message
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If

End If

End Sub

C'est plus que parfait ! Merci beaucoup, vraiment.

Bonne continuation à vous.

David

Bonjour,

Après avoir travaillé sur ce sujet à nouveau avec mes collègues, nous nous sommes aperçus qu'il peut y avoir quelques produits qui peuvent être incompatibles avec plusieurs autres produits. Il y a également des produits qui doivent être obligatoirement sélectionnés en fonction d'une sélection. Il n'y a donc plus uniquement des couples maudits. J'ai essayé de reprendre votre excellent travail Steelson pour le modifier mais sans succès. Je me demande s'il ne faudrait pas utiliser un tableau de paramétrage. Vous trouverez une proposition en pièce jointe. Pouvez-vous m'aider ?

Merci par avance,

David

Hello

Dans ton exemple, je choisis Ref3, alors Ref5 et Ref6 doivent être cochés ... mais si Ref6 est coché, alors Ref8 et Ref9 doivent aussi être cochés...mais Ref3 est incompatible avec Ref8 et Ref9 ... c'est donc la quadrature du cercle !

Merci Steelson, effectivement cela ne peut pas fonctionner. Il ne peut pas y avoir des couples à la fois compatibles et incompatibles. Voici mon exemple corrigé. Je pense que celui-ci peut fonctionner. Comme quoi, un regard extérieur est très utile...

Tout en sachant que si le mode des compatibilités "AS" ne fonctionne pas pour le moment, ce n'est pas grave. Je pourrai le gérer en créant physiquement des KIT d'articles.

David17340 a écrit :

si le mode des compatibilités "AS" ne fonctionne pas pour le moment, ce n'est pas grave. Je pourrai le gérer en créant physiquement des KIT d'articles.

C'est pas faux ... mais je regarde quand même !

Super, merci Steelson.

Il peut y avoir du chevauchement entre les 2 tableaux ? je vois Ref4 et Ref5 sur les 2

Ou alors, cela veut dire que le contrôle ne se fait QUE sur le tableau modifié ?

non c'est une erreur, il n'y a pas de chevauchement. On peut supprimer les ref 4 et 5 du tableau 1 ou 2. Désolé.

C'est rigolo, mais quand même ce n'est pas sans conséquences ...

• rigolo
  • parce que si tu supprimes la Ref 5 alors que la Ref 3 est cochée, la Ref 5 réapparaitra, c'est collant !
  • rigolo sur le plan de la programmation car elle est itérative : si Ref 3 est cochée, Ref 5 et Ref 6 aussi, et du coup Ref 10 aussi (que j'ai ajouté dans le tableau)
  • les incompatibilités sont bien commutatives mais pas les dépendances (le cochage de Ref 5 n'entraîne pas Ref 3)
• mais pas sans conséquences
  • si le tableau de la page Parametrages change, je ne teste pas les nouvelles incompatibilités et dépendances, je peux le faire en signalant ls erreurs
  • si j'efface la croix de Ref 3, je n'enlève pas celles de ses dépendances ou composants car ces Ref ont pu être induites par d'autres
  • il y a un risque fort de bouclage à l'infini s'il y a des incohérences dans le tableau de Parametrages genre j'induis une dépendance incompatible avec une autre référence

Private Sub Worksheet_Change(ByVal Target As Range)
Dim IC As Object, ref, des

' recherche référence et désignation modifiée
ref = "": des = ""
For Each tbl In ActiveSheet.ListObjects
    If Not Application.Intersect(Target, tbl.ListColumns(1).DataBodyRange) Is Nothing Then
        ref = Target.Value
        des = Target.Offset(0, 1).Value
        Exit For
    End If
    If Not Application.Intersect(Target, tbl.ListColumns(3).DataBodyRange) Is Nothing Then
        ref = Target.Offset(0, -2).Value
        des = Target.Offset(0, -1).Value
        Exit For
    End If
Next

If ref <> "" Then

    On Error GoTo fin ' si effacement de toute la feuille
    If Target.Rows.Count > 1 Then
        MsgBox "Une seule sélection à la fois !"
        Application.EnableEvents = False
            Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If
    On Error GoTo 0

    ' couples maudits
    Data = Sheets("Parametrages").ListObjects("Tref").Range.Value
    Set IC = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(Data)
        For j = 2 To UBound(Data, 2)
            If Data(i, j) = "IC" Then
            ' on met ici les couples maudits dans un dictionnaire
                IC(Data(i, 1) & "|" & Data(1, j)) = ""
                IC(Data(1, j) & "|" & Data(i, 1)) = ""
            End If
        Next
    Next

    ' recherche des incompatibilités entre ref et tous les tableaux
    Message = ""
    For Each tbl In ActiveSheet.ListObjects
        Data = tbl.DataBodyRange.Value
        For i = 1 To UBound(Data)
            If Data(i, 3) <> "" Then
                If IC.exists(Data(i, 1) & "|" & ref) Then
                    Message = Message & vbCrLf & Data(i, 1) & " (" & Data(i, 2) & ") et " & ref & " (" & des & ")"
                End If
            End If
        Next
    Next

    ' sanction
    If Message <> "" Then
        MsgBox "Incompatibilité détectée !" & vbCrLf & Message
        Application.EnableEvents = False
            Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If

End If

' ==============================================================

' activation des dépendances
' en l'absence de 'Application.EnableEvents = False' le code sera bien revolving
' et repartira sur toutes les zones changées
Dim adresse As Object
Set adresse = CreateObject("Scripting.Dictionary")

' stockage des adresses
For Each tbl In ActiveSheet.ListObjects
    For i = 1 To tbl.ListRows.Count
        adresse(tbl.DataBodyRange.Cells(i, 1).Value) = tbl.DataBodyRange.Cells(i, 3).Address
    Next
Next

For Each tbl In ActiveSheet.ListObjects
    For n = 1 To tbl.ListRows.Count
        ' ref de tous les tableaux
        ref = tbl.DataBodyRange.Cells(n, 1).Value
        ' si la ref est cochée
        If tbl.DataBodyRange.Cells(n, 3).Value <> "" Then
            ' on aura ici les cases avec libellés AS
            Data = Sheets("Parametrages").ListObjects("Tref").ListColumns(ref).DataBodyRange.Value
            ' et ici les références dépendantes
            LesRef = Sheets("Parametrages").ListObjects("Tref").ListColumns(1).DataBodyRange.Value
            For i = 1 To UBound(Data)
                If Data(i, 1) = "AS" Then
                    If Range(adresse(LesRef(i, 1))) = "" Then Range(adresse(LesRef(i, 1))) = "x"
                End If
            Next
        End If
    Next
Next

fin:
End Sub