Regrouper des mots

Le 09/03/2022 à 11:20

Bonjour,

Pouvez-vous m'aider?

J'ai 4 feuilles Excel Nomées: ESPAGNOL, ITALIEN, ANGLAIS, ALLEMAND

Dans ces feuilles en colonne A= Français colonne B= ESPAGNOL ou les autres

J'aimerais regrouper les mots français sur une colonne avec les mots ESPAGNOL, ITALIEN, ANGLAIS, ALLEMAND correspondant sur les 4 colonnes suivantes (voir image ci-contre)
Quand on saisi un mot en Français les 4 mots des autres langues apparaissent à côté.

Merci de votre aide

Le 09/03/2022 à 11:27

Bonjour Geoffroy63, le forum,

Je doute que tu obtiennes de l'aide sans fichier....

C'est un forum Excel, pas Photoshop,

Cordialement,

Le 09/03/2022 à 11:54

Bonjour

Je vais reduire mes fichiers et envoyer

Encore merci trop sympa

@ bientôt

Le 09/03/2022 à 13:54

Bonjour

ci-joint petit fichiers de 10 lignes pour exemple:

Merci

17regroupement.xlsx (13.29 Ko)

Le 09/03/2022 à 17:48

Re,

Un essai....

Pour le regroupement, la macro est exécutée à l'activation de la feuille Regroupement.

J'ai mis toutes tes données sous forme de tableaux structurés: https://www.excel-pratique.com/fr/astuces/tableau-structure

Je boucle sur la première colonne de chaque tableau pour récupérer le verbe en français (au cas où on aurait des mots en plus où en moins d'une feuille à une autre).
J'écris les verbes sans doublons dans la colonne A de la feuille Regroupement.
J'utilise la fonction Index Equiv sur les autres colonnes pour retrouver la correspondance.

Private Sub Worksheet_Activate()
  Dim tablo, tabloR(), k As Long, i As Long
 Dim dico As Object
 Dim ws, sh As Worksheet

    Set ws = Sheets(Array("ALLEMAND", "ITALIEN", "ANGLAIS", "ESPAGNOL"))
   Set dico = CreateObject("Scripting.Dictionary") '.......définit le dico

    For Each sh In ws  'boucle sur les 4 feuilles ("ALLEMAND", "ITALIEN", "ANGLAIS", "ESPAGNOL")
      tablo = sh.ListObjects(1).ListColumns(1).DataBodyRange 'tableau de valeur en fonction de la feuille
      k = 0
       For i = 1 To UBound(tablo, 1) '........................boucle sur toutes les lignes de tablo
        If Not dico.exists(tablo(i, 1)) Then '................si le verbe ne figure pas dans le dico
         dico(tablo(i, 1)) = tablo(i, 1) '....................on ajoute le verbe au dico
         k = 1 + k
        End If
       Next i
    Next sh

    With Sheets("Regroupement")
     If Not .ListObjects("TbRegroupement").DataBodyRange Is Nothing Then .ListObjects("TbRegroupement").DataBodyRange.Delete
      On Error Resume Next
     .Range("A2").Resize(dico.Count, 1) = Application.Transpose(dico.keys) 'on transpose le contenu du dico en A2
     'Fonctions Index Equiv pour trouver les correspondances
     .ListObjects("TbRegroupement").ListColumns("ESPAGNOL").DataBodyRange.FormulaR1C1 = "=INDEX(tbEspagnol[ESPAGNOL], match([@[FRANÇAIS]],tbEspagnol[FRANÇAIS],0))"
     .ListObjects("TbRegroupement").ListColumns("ITALIEN").DataBodyRange.FormulaR1C1 = "=INDEX(tbItalien[ITALIEN], match([@[FRANÇAIS]],tbItalien[FRANÇAIS],0))"
     .ListObjects("TbRegroupement").ListColumns("ANGLAIS").DataBodyRange.FormulaR1C1 = "=INDEX(tbAnglais[ANGLAIS], match([@[FRANÇAIS]],tbAnglais[FRANÇAIS],0))"
     .ListObjects("TbRegroupement").ListColumns("ALLEMAND").DataBodyRange.FormulaR1C1 = "=INDEX(tbAllemand[ALLEMAND], match([@[FRANÇAIS]],tbAllemand[FRANÇAIS],0))"
    End With
End Sub

10geoffroy63.xlsm (25.40 Ko)

Cordialement,

Le 09/03/2022 à 18:03

Bonsoir

merci beaucoup

mais il n'y a que le français qui s'affiche.

j'essaye de trouver pourquoi

@bientôt

Le 09/03/2022 à 18:21

Re,

Merci pour le retour,

il n'y a que le français qui s'affiche

Bizarre....chez moi j'obtiens ceci:

Cordialement,

Le 09/03/2022 à 18:46

Bonsoir

Oui vraiment bizarre.

Si toi tout fonctionne, c'est qu'il y a un petit problème chez moi ou au téléchargement.

Je télécharge à nouveau et essaye encore.

En tout cas un grand merci à toi et un énorme merci pour avoir ajouté quelques REM et donné des explications. C'est rare

Merci pour le retour,

C'est la moindre des politesses de vous répondre.

On vous demande une aide, car on est incapable de faire ce vous faites avec VBA, donc un retour ou un merci ce n'est pas grand chose par rapport à votre travail effectué pour nos besoins. Merci

Bonne soirée

@BIENTÔT

Le 09/03/2022 à 19:12

Re,

Mon premier jet.....avec un bouton, au cas où....

Supprime la MFC pour voir....(elle masque les erreurs avec police en blanc).

7geoffroy63-regroupement.xlsm (30.38 Ko)

Cordialement,

Le 09/03/2022 à 19:47

Bonsoir

merci mais c'est pareil

j'ai foncé les cellules au cas ou

ci-joint le même fichier...pour voir?

7geoffroy63-regroupement2.xlsm (27.02 Ko)

@bientôt

Le 09/03/2022 à 20:15

Re,

Alors là, je n'y comprends plus rien....

Chez moi:

J'en reste là pour aujourd'hui....je bosse tôt demain...

Cordialement,

Le 10/03/2022 à 08:45

Bonjour,

je suis sur Excel 2007, peut-être que cela vient de là?

merci

dommage pour moi

@ bientot

Le 11/03/2022 à 08:51

Bonjour xorsankukai,

J'ai pu me débrouiller avec ce que tu avais fait pour Samolo67 le 5/10/2020 (dico-mots-les-plus-utilisees.xlsm )

Ce n'est pas parfait mais ça fonctionne

Juste un petit détail si tu peux me le corriger: L'erreur "#N/A" qui apparaît de temps en temps

comment modifier ça pour remplacer cette erreur par " pas d'équivalence"?

merci de ton aide ci-joint le résultat

@ bientôt

Le 11/03/2022 à 10:05

Bonjour,

Comment avez-vous fait pour créer ce tableau: TableauCorrespondance?

je ne sais pas comment j'ai fait pour le créer , et je n'y arrive plus?

=RECHERCHEV($A2;tbItalien;EQUIV(Regroupement!$C$1;tbItalien[#En-têtes];0);0)

Où faut-il aller?

merci

Le 11/03/2022 à 13:13

Bonjour

Pour l'erreur "#N/A" peut-on supprimer (ou ne pas la mettre) toutes les lignes où il ne trouve pas l'équivalence?

merci

@ bientôt

Le 11/03/2022 à 17:28

Bonjour Geoffroy, le forum,

Juste un petit détail si tu peux me le corriger: L'erreur "#N/A" qui apparaît de temps en temps

Il faut utiliser "SIERREUR" dans ta formule...https://www.excel-pratique.com/fr/fonctions/sierreur

Nouvelle tentative.....

13geoffroy-v2.xlsm (29.86 Ko)

Cordialement,

Le 11/03/2022 à 18:08

Bonsoir et merci

ça fonctionne sur ce fichier, mais si je transfert la macro sur un autre fichier ça ne fonctionne plus.

Je crois qu'il faut créer le tableau comme sur l'image mais je ne sais pas où il faut cliquer

impossible de le refaire ????

merci beaucoup

@bientôt

Le 11/03/2022 à 18:17

Re,

Pour chaque feuille, il faut mettre tes données sous forme de tableau structuré: https://www.excel-pratique.com/fr/astuces/tableau-structure
Il faut également les renommer :

tbAllemand ; tbAnglais, tbItalien,tbEspagnol, tbRegroupement (ATTENTION!, les majuscules/minuscules ont leur importance, de même pour les titres de tes colonnes).

A toi de jouer,

Le 11/03/2022 à 18:42

MERCI,

j'ai fini par trouver

j'essaye mais là il mouline

@bientôt

Le 11/03/2022 à 19:31

Re,

Si ça mouline, c'est que le code n'est pas top,

Avec 15 000 lignes....sur chaque feuille...

Avec ce code :

Private Sub Worksheet_Activate()
  Dim tablo, tabloR(), k As Long, i As Long, x
  Dim dico As Object
  Dim ws, sh As Worksheet
  Dim start As Single

  start = Timer  'départ du timer pour mesurer temps d'exécution de la macro
                 'pour le test (peut être supprimé)

     Set ws = Sheets(Array("ALLEMAND", "ITALIEN", "ANGLAIS", "ESPAGNOL"))
   Set dico = CreateObject("Scripting.Dictionary") '.......définit le dico

    For Each sh In ws  'boucle sur les 4 feuilles ("ALLEMAND", "ITALIEN", "ANGLAIS", "ESPAGNOL")
      tablo = sh.ListObjects(1).ListColumns(1).DataBodyRange 'tableau de valeur en fonction de la feuille
      k = 0
       For i = 1 To UBound(tablo, 1) '........................boucle sur toutes les lignes de tablo
        If Not dico.exists(tablo(i, 1)) Then '................si le verbe ne figure pas dans le dico
         dico(tablo(i, 1)) = tablo(i, 1) '....................on ajoute le verbe au dico
         k = 1 + k
        End If
       Next i
    Next sh

    x = dico.keys
    ReDim tabloR(1 To dico.Count, 1 To 5) '.............redimensionne le tableau final tabloR (nombre de lignes du dico,5 colonnes)
    For i = 0 To dico.Count - 1 '.......................boucle sur tous les éléments du dico
        tabloR(i + 1, 1) = dico(x(i)) '.................colonne 1 : valeur du dico (français)
    Next i

    With Sheets("Regroupement")
     'si le tableau contient déjà des données, on les supprime
     If Not .ListObjects("TbRegroupement").DataBodyRange Is Nothing Then .ListObjects("TbRegroupement").DataBodyRange.Delete
      On Error Resume Next
     .Range("A2").Resize(dico.Count, 5) = tabloR  '.....écrit les données de TabloR à partir de A2
     'RechercheV et Sierreur
     .Range("B2") = IIf(IsError(Application.VLookup(.Range("A2"), Sheets("ESPAGNOL").ListObjects("tbEspagnol").DataBodyRange, 2, False)), "", Application.VLookup(.Range("A2"), Sheets("ESPAGNOL").ListObjects("tbEspagnol").DataBodyRange, 2, False))
     .Range("C2") = IIf(IsError(Application.VLookup(.Range("A2"), Sheets("ITALIEN").ListObjects("tbItalien").DataBodyRange, 2, False)), "", Application.VLookup(.Range("A2"), Sheets("Italien").ListObjects("tbItalien").DataBodyRange, 2, False))
     .Range("D2") = IIf(IsError(Application.VLookup(.Range("A2"), Sheets("ANGLAIS").ListObjects("tbAnglais").DataBodyRange, 2, False)), "", Application.VLookup(.Range("A2"), Sheets("ANGLAIS").ListObjects("tbAnglais").DataBodyRange, 2, False))
     .Range("E2") = IIf(IsError(Application.VLookup(.Range("A2"), Sheets("ALLEMAND").ListObjects("tbAllemand").DataBodyRange, 2, False)), "", Application.VLookup(.Range("A2"), Sheets("ALLEMAND").ListObjects("tbAllemand").DataBodyRange, 2, False))
     .Range("B2:E" & .Range("A" & Rows.Count).End(xlUp).Row).FillDown
    End With
    Set ws = Nothing: Set dico = Nothing: Erase tabo: Erase tabloR '....libère la mémoire
    MsgBox "durée du traitement: " & Timer - start & " secondes" '......temps d'exécution de la macro pour test
                                                                        'pour le test (peut être supprimé)
End Sub

Si un pro passe dans le coin,il y a certainement mieux à faire....

Cordialement,

Rechercher des sujets similaires à "regrouper mots"