XL 2016 Remplacement du contenu d'une cellule par une autre

[Phytoman]

Bonjour à tous et merci pour vos éventuelles suggestions
Un de mes amis fan de foot me demande de l'aider à constituer une fichier Excel dans lequel il pourrait automatiser la mise en correspondance d'une cellule par rapport à une autre.
Je m'explique :
Il a un petit site dédié au foot dans lequel il remonte tous les résultats téléchargés sur la plateforme officielle de la fédération belge.
Lorsque c'est fait il doit convertir chaque nom de club (un par un) dans une version "raccourcie" avant de les envoyer sur son site.
En effet, les noms utilisés dans la fédération est trop long. Le nom présent dans CLUB devrait être remplacé par sa version WF MATCH.
exemple :

CLUB	wf match
K.RC.Genk	Genk
Cercle Brugge K.SV.	Cercle de Bruges
K.St.-Truidense VV.	Saint-Trond
SV.Zulte Waregem	Zulte Waregem
KV.RS.Waasland-SK.Beveren	Waasland-Beveren
R.SC.Anderlecht	Anderlecht
R. Fraiture Sp A	Fraiture Sports

Là ou cela se corse, c'est qu'il doit en plus convertir son fichier de résultats. Celui-ci remonte tous les matchs avec l'appellation longue des clubs.
R. Fraiture Sp A deviendrait alors Fraiture Sports

3A	18-08-19​	15:00​	Racour A	Oreye	2​	2​
3A	18-08-19​	15:00​	Templiers Nandrin B	Rfc.Huy B	1​	2​
3A	18-08-19​	15:00​	Fizoise B	Ouffet Warzée	0​	1​
3A	18-08-19​	15:00​	R. Fraiture Sp A	Huccorgne	0​	3​
3A	18-08-19​	15:00​	Warnant B	Burdinne	0​	2​
3A	18-08-19​	15:00​	RSC. Haneffe	JSK Crisnée	3​	1​

J'espère avoir été clair
Merci de votre aide

 

[Paf]

Bonjour,

si la table de correspondance CLUB=> wf match existe, une petite moulinette VBA permettrait de modifier rapidement....

Un classeur contenant cette table et les données issues de la fédération permettrait de tester et de proposer un code adapté...

A+

 

[Phytoman]

Ah ok, peu habitué aux forums, comment puis-je vous envoyer les deux fichiers sans les publier ?

 

[Paf]

peut _être supprimer les données non essentielles ou sensibles (?) en laissant juste les noms de clubs et la table de correspondance

Si ça peut suffire pour insérer le classeur ......?

 

[Phytoman]

Ces fichiers sont de toute façon téléchargeables gratuitement sur le site de la fédération En annexe :
1) Liste de tous les prochains matchs en province de Liège (toutes compétitions confondues).
2) Le fichier de correspondances (partiel il est en cours de réalisation)
Le cas échéant, devra-t-il réunir tous les matchs dans un seul fichier ?

 

[Paf]

Pour plus de simplicité, j'ai mis la feuille de correspondance dans le classeur match, en conservant son nom.

la macro suivante remplace, dans la feuille lieresdownP les noms des clubs par leur correspondance si elle est connue.

la liste des clubs inconnus est copiée en fin de feuille de correspondance (supprimer les commentaires pour l'activer), mais, attention, la relance de la macro remplacera le nom de ces clubs par ... vide...... tant que le nom "raccourci" n'est pas renseigné

à tester:

Sub Décode()
Dim Dico, Dico2, TC, i, T, FC As Worksheet, FM As Worksheet

Set Dico = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
Set FC = Worksheets("correspondances-clubs-import-un")
Set FM = Worksheets("lieresdownP")

TC = FC.Range("A2:B" & FC.Range("B" & Rows.Count).End(xlUp).Row)
For i = LBound(TC, 1) To UBound(TC, 1)
    Dico(TC(i, 1)) = TC(i, 2)
Next

T = FM.Range("E2:E" & FM.Range("E" & Rows.Count).End(xlUp).Row)
For i = LBound(T, 1) To UBound(T, 1)
    If Dico.Exists(T(i, 1)) Then
        T(i, 1) = Dico(T(i, 1))
    Else
        Dico2(T(i, 1)) = ""
    End If
Next

FM.Range("E2").Resize(UBound(T, 1), 1) = T 'copie les correspondances

'supprimer les ' devant les deux lignes suivantes pour copier les clubs sans correspondance

'derFC = FC.Range("A" & Rows.Count).End(xlUp).Row + 1
'FC.Range("A" & derFC).Resize(Dico2.Count, 1) = Application.Transpose(Dico2.keys)

End Sub

A+

 

[Phytoman]

dois-je télécharger un nouveau fichier que vous avez uploadé ?

 

[Phytoman]

1) J'ai copié-collé le contenu de la feuille "correspondances-clubs-import-un" dans le fichier "lieresdownP" dans un onglet du même nom.
2) j'ai été dans VBA -->feuille "lieresdownP" et y ai copié ton code
3) j'ai enregistré
Quand je fais exécuter la macro rien ne se passe. Quand je sélectionne les deux colonnes et exécute la macro idem ?!

 

[Paf]

Dans le fichier "matchs-liege", créez une feuille "correspondances-clubs-import-un" et y coller le contenu de la feuille du même nom du classeur "correspondances...."
dans un module standard copier la macro (ça devrait marcher si la macro est copiée dans la feuille de code d'une feuille...)
Autorisez les macros et Enregistrez en classeur Excel xlms

au besoin joignez le classeur en défaut...

A+

 

[Phytoman]

Merci pour ton aide,
Voici le fichier en attaché

 

[Paf]

Dans le code fourni seule la colonne E de la feuille lieresdownP est modifiée ...
Peut-être une méprise sur la colonne à traiter ..?
quelles sont les colonnes à "convertir" ?

 

[Phytoman]

D et E (Home = équipe qui reçoit - Away équipe visiteuse)

 

[Paf]

Ah oui ... ça change pas mal ...

Comme quoi quand tout n'est pas bien défini au départ ....


Je regarde

 

[Paf]

prise en compte des colonnes D et E, et suppression de la possibilité d'obtenir les noms complets sans correspondance:

Sub Décode()
Dim Dico, Dico2, TC, i, T, FC As Worksheet, FM As Worksheet

Set Dico = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
Set FC = Worksheets("correspondances-clubs-import-un")
Set FM = Worksheets("lieresdownP")

TC = FC.Range("A2:B" & FC.Range("B" & Rows.Count).End(xlUp).Row)
For i = LBound(TC, 1) To UBound(TC, 1)
    Dico(TC(i, 1)) = TC(i, 2)
Next

T = FM.Range("D2:E" & FM.Range("E" & Rows.Count).End(xlUp).Row)
For i = LBound(T, 1) To UBound(T, 1)
    If Dico.Exists(T(i, 1)) Then T(i, 1) = Dico(T(i, 1))
    If Dico.Exists(T(i, 2)) Then T(i, 2) = Dico(T(i, 2))
Next

FM.Range("D2").Resize(UBound(T, 1), UBound(T, 2)) = T 'copie les correspondances

End Sub

 

[Phytoman]

génial, ça marche Un grand merci à toi