XL 2013 Contrôle doublons et positions via VBA

[famu]

Bonjour à tous,
Je tourne en rond pour créer une macro de contrôle.
Dans le fichier joint tout est expliqué (du moins je j'espère !)
Si quelqu'un pouvait m'aider...
D'avance un grand merci,
Famu

 

[Dranreb]

Bonjour.
Utilisez un tableau et un Dictionary pour ça.
Pour chaque ligne retrouvez la clé dans le tableau d'après l'emplacement.
S'il elle n'existe pas dans le dico, créez la avec le n°de ligne pour Item.
Sinon vérifiez qu'elle porte déjà bien ce numéro de ligne.

Je viens d'essayer mais je m'aperçois qu'on perd la trace de l'emplacement déjà utilisé.
Plus compliqué que prévu mais je suis en passe d'y arriver.

Sub Test()
Dim PlgEmp As Range, TClés(), L&, C&, TEmp(), Clé, D As New Scripting.Dictionary, CelRés As Range
TClés = Feuil1.[A4:A18].Value
Set PlgEmp = Feuil1.[F3:J5]: TEmp = PlgEmp.Value
For L = 1 To UBound(TEmp, 1)
  For C = 1 To UBound(TEmp, 2)
    Clé = TClés(TEmp(L, C), 1)
    If D.Exists(Clé) Then
      Set CelRés = PlgEmp(L, C)
      If D(Clé) <> L Then
        Set CelRés = PlgEmp(L, C)
        L = D(Clé)
        C = 1: Do While TClés(TEmp(L, C), 1) <> Clé: C = C + 1: Loop
        Set CelRés = Union(PlgEmp(L, C), CelRés): Application.Goto CelRés
        MsgBox "Ligne différentes pour emplacements de """ & Clé & """." _
          & vbLf & "Cellules: " & CelRés.Address(0, 0), _
          vbInformation, "Test": Exit Sub: End If
    Else
      D(Clé) = L
      End If: Next C, L
End Sub

 

[famu]

Bonjour Dranreb,
Vu le code que tu viens de faire...je suis impressionné ! J'était parti avec la fonction "find", variables etc...mais là, ce que tu fais est hors de ma portée !
En tout cas, je te remercie vraiment pour l'effort fourni.
En effet, c'est pas simple, mais j'ai confiance.
je ne peux qu'attendre...

 

[Dranreb]

Autre version qui indique toutes les cellules incriminées :

Sub Test2()
Dim PlgEmp As Range, TClés(), L&, C&, TEmp(), Clé, D As New Scripting.Dictionary, CelRés As Range
TClés = Feuil1.[A4:A18].Value
Set PlgEmp = Feuil1.[F3:J5]: TEmp = PlgEmp.Value
For L = 1 To UBound(TEmp, 1)
  For C = 1 To UBound(TEmp, 2)
    Clé = TClés(TEmp(L, C), 1)
    If Not D.Exists(Clé) Then
      D(Clé) = L
    ElseIf D(Clé) <> L Then
      Set CelRés = PlgEmp(L, C): GoTo Zut: End If: Next C, L
Exit Sub
Zut: For L = 1 To UBound(TEmp, 1)
  For C = 1 To UBound(TEmp, 2)
     If TClés(TEmp(L, C), 1) = Clé Then Set CelRés = Union(PlgEmp(L, C), CelRés)
     Next C, L
Application.Goto CelRés
MsgBox "Lignes différentes pour emplacements de """ & Clé & """." _
  & vbLf & "Cellules: " & CelRés.Address(0, 0), vbInformation, "Test"
End Sub

Ne pas oublier de cocher la référence Microsoft Scripting Runtime

 

[famu]

OK. Je vais essayer de l'adapter à mon fichier....
Encore merci.
Je reviens vers vous dès que possible pour vous informer.

 

[pierrejean]

Bonjour famu
Salut Dranreb

Je l'ai fait , je le poste

 

[famu]

Bonjour PierreJean...content de vous voir. Ce n'est pas la première fois que vous me venez en aide !
Pour Dranreb : c'est presque bon mais si je mets tous les "A" en emplacement 1, par exemple, et que je relance la macro il garde en mémoire les anciennes infos.
Pour PierreJean : ben...çà a l'air de fonctionner nickel !
Je l'adapte à mon fichier et vous tiens informé mais pas avant début de semaine prochaine car c'est le W.E.
Grand merci à vous 2 car pour moi, c'est de la "haute voltige". BRAVO !

 

[famu]

Me revoilà...déjà...
Je viens de l'adapter dans mon fichier et l'exemple est légèrement différent...presque rien (voir Feuil1 (2))...mais...

 

[Dranreb]

Je n'ai pas tenu compte de la colonne B parce que ça me semblait n'être que des numéros d'ordres de 1 à 15
je me suis donc fié seulement à la leur position verticale.

Edit: Dans votre nouveau problème un emplacement peut être défini pour plusieurs lettres différentes de sorte que je ne comprend plus de quelle lettre un autre ou le même emplacement ne doit pas figurer dans une autre ligne…

 

[pierrejean]

Re

Voici l'adaptation

 

[famu]

Merci PierreJean. J'essayerai ça mardi.
Bon week-end.

 

[famu]

Bonjour PierreJean,
J'ai essayé d'adapter votre code à mon fichier d'origine mais ça ne fonctionne pas.
Je pensais y arriver comme un grand...
J'ai créé la Feuil2 qui est une copie de mon fichier et un bouton Macro dont la Macro a été modifiée...mais sans résultat.
Pas toujours facile VBA.
D'avance merci

 

[pierrejean]

RE

Voila

 

[famu]

PierreJean...tout paraît si simple ! J'ai vu pourquoi ça ne fonctionnait pas.
Un super MERCI.
Très bonne journée.

 

[famu]

Bonjour,
Je reviens avec le fichier dont PierreJean et Dranreb m'avait bien aidé.
Je voudrais avoir une autre possibilité de contrôle (Feuil "Ctrl code unique ts emplacmts"). Tout y est expliqué.
En fait, je ne voudrais plus, pour cette macro, considérer les Lignes. Ce qui devrait être plus simple (?)
D'avance merci pour votre aide.