Déterminer les correspondances entre 2 colonnes
Bonjour à tous,
Comme je suis dans l’impossibilité de résoudre mon problème, je me permets de poster ma demande en espèrent que quelqu’un peut m’aider à trouver une solution.
Mon Range se compose de trois colonnes ("D3:F" & dernière ligne), les données du Range sont encodées manuellement à chaque nouveau concours, le nombre de lignes de notre réel Range contient des données assez conséquentes, je l’ai réduit pour les besoins de ma demande.
Petite information : on ne touche pas aux cellules dont le contenu est égale à "x", elle me servent pour d'autres utilisations
Dans notre cas ici présent, notre Range (Voir fichier joint) commence à "D3" et finit à "E17", il se compose de 3 colonnes :
La colonne "D" contient les divers classes auxquelles les éleveurs peuvent participer.
La colonne "E" contient les juges qui expertisent les diverses classes.
La colonne "F" contient le nombres d’oiseaux par classes à cette colonne est présente mais ne sera pas utilisée dans notre cas ici présent.
Ce que je souhaite faire (via une Macro en vba), c’est déterminer les juges (Colonne "E") et les classes expertisées (Colonne "D") par chacun d’entre eux.
En remarque que, dans notre colonne "E", il y’a 5 juges différents.
En partant de cela, on peut aisément déterminer les classes expertisées par ces derniers en colonne "D".
Ce qui donne le résultat suivant :
Le juge ABADI Alfred va expertiser les classes : A4T et B4T
Le juge BOURDON Stéphane va expertiser les classes : BK, KB4T, C et CK
Le juge DASILVA Thomas va expertiser les classes : CK4T, D et E
Le juge ERIKSEN Michel va expertiser les classes : A, AK et AK4T
Et enfin, le juge MARTINEZ Josef va expertiser les classes : B, C4T, et F
En ayant ces informations, je souhaite les écrire dans les cellules de la colonne "K" à partir de la cellule "K15" de la manière suivante :
La Cellule "K15" = En Classes A4T et B4T : ABADI Alfred à Voir le fichier joint.
La Cellule "K16" = En Classes BK, BK4T, C et CK : BOURDON Stéphane à Voir le fichier joint.
La Cellule "K17" = En Classes CK4T, D et E : DASILVA Thomas à Voir le fichier joint.
La Cellule "K18" = En Classes A, AK et AK4T : ERIKSEN Michel à Voir le fichier joint.
La Cellule "K19" = En Classes B, C4T et F : MARTINEZ Josef à Voir le fichier joint.
Je reste à votre disposition pour toutes informations supplémentaires.
Merci d’avance pour vos contributions.
Bonjour,
Autre proposition:
le code:
Sub Liste()
Dim i As Long, DerLig As Long, Lig_Dest As Long, Deb As Long, Pos_der_virg As Long
Dim j As Range
Dim Classe As Variant
Application.ScreenUpdating = False
DerLig = Range("D" & Rows.Count).End(xlUp).Row
Lig_Dest = 15
For i = 2 To DerLig
If i > 2 Then
Juge = Cells(i, "E")
With Range("E2:E" & DerLig)
Set j = .Find(Juge)
If Not j Is Nothing Then
Deb = j.Row
Do
Classe = Classe & " , " & Cells(j.Row, "D")
i = j.Row
Set j = .FindNext(j)
Loop While Not j Is Nothing And j.Row <> Deb
End If
End With
Classe = Right(Classe, Len(Classe) - 3)
Classe = "En Classes" & Classe & ": " & Juge
Pos_der_virg = InStrRev(Classe, " , ", -1)
Mid(Classe, Pos_der_virg, 4) = " et "
Cells(Lig_Dest, "K") = Replace(Classe, " , ", ",")
Classe = ""
Lig_Dest = Lig_Dest + 1
End If
Next i
End SubCdlt
Salut Harzer,
Salut Arturo, Fanfan,
et une autre proposition VBA avec, comme d'hab', un double-clic sur la feuille pour démarrer la macro
For x = 3 To iRow
sJuge$ = Range("E" & x).Value
iRow2 = Columns(5).Find(what:=sJuge, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
sMsg = IIf(iRow1 = iRow2, "En classe ", "En classes ")
For y = iRow1 To iRow2
sMsg = sMsg & IIf(y = iRow2 And iRow1 < iRow2, " et ", IIf(y = iRow1, "", ", ")) & Range("D" & y).Value
Next
Range("K" & IIf(Range("K15").Value = "", 15, Range("K" & Rows.Count).End(xlUp).Row + 1)).Value = sMsg & " : " & sJuge
x = iRow2
iRow1 = iRow2 + 1
NextA+
Bonjour Fanfan38, Arturo83, curulis57 et les membres du Forum,
Merci à vous pour vos retour et les codes proposés
Pour ne pas m’emmêler les pinceaux à vous répondre dans l’ordre que j’ai reçu vos messages et je réponds à chacun d’entre vous individuellement.
Je commence par FanFan38 pour lui dire que la liste des juges en colonne "E" est variable, les noms des juges changent à chaque concours, pour que cela soit applicable dans pour tous les cas, il serait souhaitable de mettre les noms des juges de la colonnes "E" dans des variables, ainsi, lorsque je change le nom de juge, le code sera toujours fonctionnel.
Pour faire mes tests, j’ai mis un nouveau non de juge " AATOURI Alberto " dans la cellule "E3", lorsque je lance la Macro, je remarque que le nom et la classe expertisée de ce dernier ne figure pas dans ma colonne "K".
Par l’occasion, je me permets de vous demander si vous voulez bien mettre à jour votre code de manière à traiter le cas d’un juge qui expertise une seule classe, c’est le cas de " ABADI Alfred" qui se trouve en "E4". (Voir pièce jointe)
A vous lire.
Bonjour Arturo 83,
Merci pour votre code.
Je l’ai testé, il fonctionne bien, à la seule exception que j’ai une erreur d’exécution ‘5’ lorsque j’ai un juge qui expertise une seule classe, merci d’y remédier.
Bien à vous et à vous lire.
Bonjour curulis57,
Merci pour votre code, il fonctionne très bien et me donne le résultat souhaité.
En plus, il traite tous les cas de figure, à savoir :
- Un juge qui expertise Plusieurs classes.
- Un juge qui expertise une seule classe.
Mon seul problème est que j’ai du mal à déchiffrer votre code pour mieux le comprendre. Peut-être si vous avez un peu de temps pour le commenter, ça sera super.
Bavo et merci.
Salut Harzer,
oui, d'ac, je vais faire ça!
Une version améliorée est possible mais il faudrait savoir :
- l'encodage des classes/juges est-il toujours exactement au même endroit ou, en tout cas, les mêmes en-têtes ?
Pas de données situées sous ces cellules ?
- même question pour l'affichage des résultats., en [K15], jamais ailleurs en fonction de je ne sais quoi?
A+
Bonjour curulis57,
Merci pour votre retour.
Juste un petite demande avant de répondre à vos questions.
Pouvez-vous (SVP) lier le code à mettre en œuvre à un bouton plutôt qu'un double-clic car j’ai déjà un autre code avec le double clic et j’ai peur que ça perturbe le fonctionnement de mon fichier. Merci à vous.
Maintenant je réponds à vos questions :
L'encodage des classes/juges est-il toujours exactement au même endroit ou, en tout cas, les mêmes en-têtes ?
L'encodage des classes / juges se fait exactement au même endroit, les En-têtes sont toujours les mêmes.
Pas de données situées sous ces cellules ?
Non, pas de données en dessous de ces cellules.
même question pour l'affichage des résultats., en [K15], jamais ailleurs en fonction de je ne sais quoi?
L’affichage des résultats se fait toujours en colonne "K" et commence toujours en [K15].
Merci à vous et bonne programmation.
A vous lire.
Bonjour curulis57,
Je vous contacte assez rapidement pour vous dire que les entêtes sont :
Bonne soirée et bonne programmation.
Salut Harzer,
Salut le forum,
bien qu'on marche sur des oeufs (aucune idée des process et des données alentour), une version améliorée à tester.
La macro démarre maintenant au moindre changement en colonnes 'Classes' ou 'Juges'.
Tu n'as donc qu'à t'occuper de ton encodage ou de l'effaçage de tes données.
j'ai testé plein de trucs mais certainement pas tout.
Cerise sur le gâteau, que j'espère bon, les résultats sont alignés entre 'Classes' et 'Juges'.
À toi de jouer!
A+
Bonjour,
Je l’ai testé, il fonctionne bien, à la seule exception que j’ai une erreur d’exécution ‘5’ lorsque j’ai un juge qui expertise une seule classe, merci d’y remédier.
Effectivement, cas de figure que je n'avais pas testé, facilement contournable en y ajoutant une gestion d'erreur comme ci-dessous:
Sub Liste()
Dim i As Long, DerLig As Long, Lig_Dest As Long, Deb As Long, Pos_der_virg As Long
Dim j As Range
Dim Classe As Variant
Application.ScreenUpdating = False
DerLig = Range("D" & Rows.Count).End(xlUp).Row
Lig_Dest = 15
For i = 2 To DerLig
If i > 2 Then
Juge = Cells(i, "E")
With Range("E2:E" & DerLig)
Set j = .Find(Juge)
If Not j Is Nothing Then
Deb = j.Row
Do
Classe = Classe & " , " & Cells(j.Row, "D")
i = j.Row
Set j = .FindNext(j)
Loop While Not j Is Nothing And j.Row <> Deb
End If
End With
Classe = Right(Classe, Len(Classe) - 3)
Classe = "En Classes" & Classe & ": " & Juge
Pos_der_virg = InStrRev(Classe, " , ", -1)
On Error Resume Next
Mid(Classe, Pos_der_virg, 4) = " et "
On Error GoTo 0
Cells(Lig_Dest, "K") = Replace(Classe, " , ", ",")
Classe = ""
Lig_Dest = Lig_Dest + 1
End If
Next i
End SubCdlt
Salut Arturo,
si je peux me permettre, les cas de correction de prénom des juges avec le même nom ne sont pas pris en compte!
Il faut absolument trier tout ça pour que ça fonctionne!
A+
Bonjour Arturo83 et curulis57,
Merci à tous les deux pour vos retours respectifs.
Je commence à répondre à Arturo83 et je répondrais à curulis57 dans un autre message.
La mise à jour que j’ai demandé est prise en compte et le résultat me satisfait, merci beaucoup.
J’ajoute que j’ai remarqué un petit détail insignifient mais si vous savez apporter une correction, je serais très content, si non, je peux me contenter du code comme il est actuellement.
Voilà ce que j’ai remarqué :
Prenons un exemple d’un juge qui expertise une seule classe, c’est le cas de AATouri Alberto en classe A4T, voir image jointe ,lorsqu’on regarde le résultat en colonne "K", on a :
En Classes A4T: AATOURI Alberto
Pouvez-vous modifier le code de manière à ce que le résultat soit comme suit :
En Classe A4T: AATOURI Alberto --> (Pas de (s) pour mot Classes)
A vraie dire, j’ai essayé d’apporter une correction moi-même à ce niveau mais sans aucun résultat concluant.
Merci pour votre patience et votre disponibilité.
Bien à vous.
Voilà la modif demandée:
Sub Liste()
Dim i As Long, DerLig As Long, Lig_Dest As Long, Deb As Long, Pos_der_virg As Long, NbCalsses As Long
Dim j As Range
Dim Classe As Variant
Application.ScreenUpdating = False
DerLig = Range("D" & Rows.Count).End(xlUp).Row
Lig_Dest = 15
For i = 2 To DerLig
NbClasses = 0
If i > 2 Then
Juge = Cells(i, "E")
With Range("E2:E" & DerLig)
Set j = .Find(Juge)
If Not j Is Nothing Then
Deb = j.Row
Do
Classe = Classe & " , " & Cells(j.Row, "D")
i = j.Row
NbClasses = NbClasses + 1
Set j = .FindNext(j)
Loop While Not j Is Nothing And j.Row <> Deb
End If
End With
Classe = Right(Classe, Len(Classe) - 3)
If NbClasses = 1 Then
Classe = "En Classe" & Classe & ": " & Juge
Else
Classe = "En Classes" & Classe & ": " & Juge
End If
Pos_der_virg = InStrRev(Classe, " , ", -1)
On Error Resume Next
Mid(Classe, Pos_der_virg, 4) = " et "
On Error GoTo 0
Cells(Lig_Dest, "K") = Replace(Classe, " , ", ",")
Classe = ""
Lig_Dest = Lig_Dest + 1
End If
Next i
End SubBonjour Arturo83,
Merci pour votre retour rapide et efficace.
Le code répond à mes attentes. Bravo pour votre travail.
Merci également pour l’aide apportée lors de mes précédentes demandes.
Maintenant je vais répondre à curulis57
Salutations.
re,
@Curulis57, avec un dictionaire
Sub Curilus()
Dim rCel As Range, iRow%, iRow1%, iLen%, iRow2%, sJuge$, sMsg$
Dim Dict, aKeys, aItems, Arr, i, j
Dim iIndent: iIndent = 30 'à partir de là, le nom des juges
'Recherche de l'en-tête 'Nbre oiseaux'
With Sheets("Feuil1")
Set rCel = .Cells.Find(what:="Nbre oiseaux", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
If rCel Is Nothing Then
'si pas d'en-tête (effacé ou modifié)
MsgBox "L'en-tête 'Nbre oiseaux' est introuvable!" & Chr(10) & _
"Impossible de localiser la zone d'encodage!", vbCritical + vbOKOnly, "Info"
Else
Arr = rCel.Offset(1, -2).Resize(Cells(Rows.Count, rCel.Column - 1).End(xlUp).Row - rCel.Row, 2).Value
Set Dict = CreateObject("scripting.dictionary")
Dict.comparemode = vbTextCompare
For i = 1 To UBound(Arr)
Dict(Arr(i, 2)) = Dict(Arr(i, 2)) & "|" & Arr(i, 1) 'key=juge, item = classes, séparateur "|"
Next
aKeys = Dict.keys
aItems = Dict.items
For i = 0 To UBound(aKeys)
j = UBound(Split(aItems(i), "|")) 'nombre de séparateurs = nombre de classes
If j > 1 Then aItems(i) = Mid(Replace(Replace(aItems(i), "|", ", ", , j - 1), "|", " et "), 2) 'plus qu'une classe = ajouter " et " et remplacer séparateurs
aItems(i) = "En Classe" & IIf(j = 1, " ", "s ") & Mid(aItems(i), 2)
aItems(i) = aItems(i) & WorksheetFunction.Rept(" ", Application.Max(0, iIndent - Len(aItems(i)))) & aKeys(i)
Next
'préparation des cellules-résultats
With .Range("K15:K100")
.ClearContents
.Font.Name = "Consolas"
.Font.Size = 11
.HorizontalAlignment = xlHAlignLeft
.VerticalAlignment = xlVAlignCenter
.IndentLevel = 1
.Resize(Dict.Count).Value = Application.Transpose(aItems)
End With
End If
End With
End SubBonjour curulis57,
Merci pour votre retour et le code proposé.
Que dire de ce dernier, je cherche encore mes mots …. : il est excellent, c’est Magique.
Bravo pour ce code, vous avez pensé à tous les détails, le travail se fait en arrière-plan automatiquement, tout ce que je dois faire, c’est modifier les données au niveau de mon Range en encodant les juges et les classes dans mes colonnes ("D:F")
Petite remarque au passage : C’est bien qu’un retraité puisse aider un autre retraité!
Cordiale poignée de mains.
Bonjour BsAlv,
Avant tout, je suis très content de vous retrouver.
Merci pour votre code, ce dernier comme d’habitude toujoures efficace, performant et me satisfait totalement.
Au plaisir de vous relire.
Salutations Amicales.
Merci BsAlv pour ce code!
Je vais étudier cela très attentivement : ce sera encore une belle corde à mon arc.
Comment faudrait-il faire si, au lieu d'ajouter les intitulés de classe et en supposant qu'il y ait des classes en doublon pour le même prof, on demandait "simplement" le nombre de fois que chaque classe apparaît ?
A+