VBA - UserFrom variable - Lier ComboBox/TextBox à la feuille

Bonsoir,

Ce post fait suite au post précédent :

https://forum.excel-pratique.com/viewtopic.php?f=2&t=125434

Mais avec davantage de précisions et une requête un peu plus précise !

Le code VBA actuel fonctionne ainsi :

Lorsque dans ma colonne D apparaît le terme "Code erroné" alors, un UserForm apparaît.

Dans cet UserForm, il va apparaître autant de TextBox qu'il n'y a de fois le terme "Code erroné".

Ça marche bien, mais à ce stade, ça me sert à rien... Et je ne vois pas comment m'y prendre pour la suite...

J'aimerais que dans chaque TextBox, il apparaisse, tout simplement l'information qui est présente dans la colonne C à chaque fois qu'il apparaît "Code erroné" dans la colonne D.

Et ensuite, j'aimerais que lorsqu'on modifie l'information dans chaque TextBox, cette dernière soit renseignée dans la chaque cellule de la colonne C correspondantes.

Lorsque les modifs sont faites, on valide et un autre UserForm apparaît. Dans celui-ci, sont générés autant de ComboBox qu'il n'y a de fois le terme "Code jumeaux" dans la colonne D.

Ce qui serait bien, c'est que chaque ComboBox propose une liste déroulante de propositions qui vont rechercher, pour chaque "Code jumeaux", dans une Base de données, la correspondance avec la valeur renseignée dans la colonne C.

[Habituellement, cette recherche peut se faire en créant un nom, qui fait référence à cette formule : "=DECALER('Database complete'!$F$1; EQUIV(Correspondances!$C2;'Database complete'!$A:$A;0)-1; ; EQUIV(Correspondances!$C2;'Database complete'!$A:$A;0) - EQUIV(Correspondances!$C2;'Database complete'!$A:$A;0) +1)

Puis en insérant ou outil de validation des données sous forme de listes

J'ajoute un document en PJ, avec quelques explications imagées car c'est pas très évident à expliquer !

J'espère qu'il existe une solution et que j'ai pas fait ça pour rien !

Merci pour votre attention,

Bonne fin de soirée !

Bonsoir,

ci-jointe une solution qui me parait plus simple avec :

• deux tableaux structurés (menu Insertion --> bouton Tableau)
• une Listbox , une TextBox et une Combobox.

Bonjour !

J'ai commencé à regarder le document que vous avez envoyé. Il va me falloir un peu de temps pour comprendre comment il fonctionne et si je peux adapter certaines parties (du genre, lorsqu'on écrit dans une textbox, que le résultat ne s'affiche pas en colonne D mais en colonne C pour que les correspondances puissent être refaites ensuite ; rien d'extraordinaire comparé à ce que vous avez fait !)

De premier abord, la manière dont vous procédez et le rendu final collent bien davantage à ce que j'espérais, avec un aspect beaucoup plus professionnel en plus !

Je vais encore tester dès que j'en ai la possibilité, néansmoi c'est déjà fabuleux ce que vous m'apportez là ! Je vous remercie pour le temps passé à essayer de résoudre mon problème, je ne m'attendais pas à un résultat aussi proche de ce que j'espérais.

Je reviens dès que j'ai terminé de comprendre et d'adapter

Bonne journée !

Bonjour,

C'est plutôt complexe !

Le code effectue exactement ce que je cherchais à faire ; en revanche, lorsqu'on modifie une valeur dans l'UserForm : "Modif erroné", la modification apparaît en colonne D. J'aurais besoin qu'elle apparaisse en colonne C, pour que les calculs soit reproduits par la suite sur les cellules en question (ça c'est bon).

D'ailleurs, j'ai également essayé de faire apparaître, dans TextBox, l'information contenue dans la cellule en cours de modification (habituellement j'utilisais Me.Textbox... = ...)

La méthode que vous utilisez est compliquée pour moi, il n'y a pas de code pour l'objet "TextBox" (Tbx_code_Change) ; et lorsque je tente quelques modifications, j'ai quelques crash.

Je pense que pour changer la destination des modifications faites dans l'UserForm : "Modif erroné" ça se fait ici :

If correspondance = Erroné Then
            Modif_erroné.Show
            .List(.ListIndex, 1) = Modif_erroné.Tbx_code

Mais, s'il suffisait de modifier la valeur "2"...

Une autre question ; peut-on structurer les tableaux par un code VBA à l'ouverture du document ? J'ai vu dans l'enregistreur de macro que ça a l'air possible, mais personne ne semble en parler dans les forums.

Bonne journée !

A plus tard.

Je vais continuer à chercher.

Pour la création des tableaux structurés je m'y prend ainsi :

Sub structab()

Dim lcco As Long
Dim a As Range, b As Range, Plgtbl As Range

Set dc = Worksheets("Database complete")
Set co = Worksheets("Correspondances")

lrdc = dc.Cells(Rows.Count, 1).End(xlUp).Row
lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
lcco = Cells(1, Cells.Columns.Count).End(xlToLeft).Column

With co
 If .ListObjects.Count Then
    .ListObjects(1).Name = "Bdd_complète"
  Else
    .ListObjects.Add(xlSrcRange, Intersect(.UsedRange.EntireRow, .[A:M]), , xlYes).Name = "Bdd_complète"
  End If
End With

With dc
 If .ListObjects.Count Then
    .ListObjects(1).Name = "Correspondances"
  Else
    .ListObjects.Add(xlSrcRange, Intersect(.UsedRange.EntireRow, .[A:AQ]), , xlYes).Name = "Correspondances"
  End If
End With
End Sub

Sauf que l'UserForm ne s'ouvre plus avec l'erreur suivante '91' "Variable ou variable de bloc with non défini"

Je reviens dès que j'ai un peu de temps.

A plus tard !

Le Drosophile a écrit :

Je pense que pour changer la destination des modifications faites dans l'UserForm : "Modif erroné" ça se fait ici :

If correspondance = Erroné Then

Modif_erroné.Show

.List(.ListIndex, 1) = Modif_erroné.Tbx_code

Exact. Ceci modifie bien la colonne Espèces de la ListBox.

(sous réserve de ne pas masquer la première colonne de la ListBox contenant la ligne de donnée du tableau : Me.Lbx_correspondances.ColumnWidths = "60" 'Largeur première colonne)

Pour reporter cette modif de la ListBox dans le tableau structuré de votre feuille Correspondances, il faut modifier la procédure événementielle "Sub Valider_Click" du UserForm1 ainsi :

Private Sub Valider_Click()
    Dim i As Integer, j As Long
    Dim espèce As String, correspondance As String

    '// mise à jour des correspondances erronnées à partir de la ListBox
    With Me.Lbx_correspondances
        For i = 0 To .ListCount - 1
            'récupération ligne du tableau à partir de la première colonne de la ListBox
            ' et récupération espèce modifiée à partir de la deuxième colonne de la ListBox
            j = .List(i, 0)
            espèce = .List(i, 1)

            'mofification colonne espèces de la ligne du tableau à partir de la deuxième colonne de la ListBox
            With Correspondances
                .ListColumns("especes").DataBodyRange.Rows(j) = espèce
            End With
        Next i
    End With

End Sub

ci_jointe nouvelle version

Le Drosophile a écrit :

Pour la création des tableaux structurés je m'y prend ainsi :

Si vous tenez à créer vos tableaux structurés via VBA, ce code devrait suffire :

Sub structab()

    Dim dc As Worksheet, co As Worksheet
    Dim tb As ListObject

    Set dc = Worksheets("Database complete")
    Set co = Worksheets("Correspondances")

    With dc
        Set tb = .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion)
        tb.Name = "Bdd_compl?te"
    End With

    With co
        Set tb = .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion)
        tb.Name = "Correspondances"
    End With

End Sub

Bonsoir,

J'ai fait un test rapide, espérant pouvoir travailler sur mon projet ce soir, mais finalement je ne pourrai pas.

J'ai remarqué que les corrections des codes erronés sont bien inscrites dans la colonne D, en revanche, c'est également le cas pour les codes jumeaux et synonymes. Demain soir, j'aurai beaucoup plus de temps pour travailler sur le document !

Va t-il falloir refaire le même code pour que les informations inscrites dans les textbox ne soient pas inscrites dans la même colonne ?

Le numéro des lignes affichées dans l'UserForm correspond au bon numéro -1 .

Merci beaucoup pour votre aide ! Je ne veux pas que vous pensiez que je suis simplement passé ce soir pour indiquer ce qui ne va pas et attends que vous réalisiez les modifications.

Ce soir je n'ai finalement pas pu bien m'y pencher, mais demain je regarde tout ce que vous avez proposé et essaierai d'adapter le code concernant les colonnes ! Vous m'avez vraiment apporté une aide précieuse ! Sans laquelle (je) (/ mon projet) ne serais pas allé aussi loin, j'aurais finit par me rabattre sur une solution plus proche de mon niveau...

Bonne soirée ! A demain.

Le Drosophile a écrit :

Le numéro des lignes affichées dans l'UserForm correspond au bon numéro -1 .

C'est normal car le numéro de ligne est relatif aux données du tableau, c'est à dire sans la ligne d'entête.

Première ligne de données = 1, ce qui correspond à la ligne 2 de la feuille car la ligne d'entête est en ligne 1 de la feuille.

Si par exemple, le tableau était positionné à partir de la ligne 3 de la feuille, la première ligne de donnée serait toujours égale à 1 et serait alors positionnée en ligne 4 de la feuille.

Bonsoir,

J'ai essayé de me basé sur ce que vous aviez déjà réalisé pour ajouter une troisième catégorie (la dernière) :

- les synonymes

Lorsqu'Excel trouve la mention "Synonymes" (là où il trouve également "Codes jumeaux" ou "Codes erronés"), alors il propose un UserForm avec un combobox qui propose une liste de correspondances (a priori il ne devrait y avoir qu'une seule correspondance à chaque fois, mais sait-on jamais...) Pour trouver la correspondance Excel doit chercher dans la feuille 'Database synonymes complete' ; [colonne B] et donner le résultat en [Colonne T] ("NOM VALIDE").

Je me suis retrouvé bloqué, à maintes reprises, avec cette partie du code qui ne fonctionne pas avec mes ajouts :

.DataBodyRange.Find(espèce)

Et, globalement avec les divers

.find

J'imagine que je ne suis pas loin, ayant la possibilité de m'appuyer sur ce que vous avez fait j'avais espoir que ça rendrait le tout beaucoup plus simple. QUE NENI !

Lorsqu'on effectue une modification à partir de la "combobox" pour les codes Jumeaux (et a terme les synonymes) j'ai souhaité modifié la cellule de destination de ces modifications, au lieu de la colonne C j'ai souhaité les faire passer dans la colonne D.

Le code valider ressemble désormais à ça :

Private Sub Valider_Click()
    Dim i As Integer, j As Long, k As Long
    Dim espèce As String, correspondance As String, corresp As String

    '// mise à jour des correspondances erronées à partir de la ListBox
    With Me.Lbx_correspondances
        For i = 0 To .ListCount - 1
            'récupération ligne du tableau à partir de la première colonne de la ListBox
            ' et espèce modifiée à partir de la deuxième colonne de la ListBox
            j = .List(i, 0)
            k = .List(i, 0)
            espèce = .List(i, 1)
            correspondance = .List(i, 2)

            'mofification colonne espèces de la ligne du tableau (à partir de la deuxième colonne de la ListBox)
            With Correspondances
                .ListColumns("especes").DataBodyRange.Rows(j) = espèce
            End With
            With Correspondances
                .ListColumns("Correspondance").DataBodyRange.Rows(k) = correspondance
            End With
        Next i
    End With

End Sub

Mais il ne fait absolument rient de plus qu'avant. Je n'ai pas compris son fonctionnement.

Et maintenant, je vais essayer de voir pour faire apparaître dans les TextBox qui s'affichent, les codes erronés qui correspondent.

C'est pas quelque chose de bien compliqué en général, mais dans ce contexte précis je ne sais pas comment m'y prendre pour le moment.

Je joins le document Excel avec mes modifications, en ne conservant que ce qui ressemble le plus à quelque chose, si vous souhaitez y jeter un œil. Les codes s'inspirent de ce que vous avez déjà fait (notamment parce qu’il s'agissait de reproduire la démarche).

Je vais continuer mes tests.

Bonne soirée !

Bonsoir,

J'ai déjà procédé à quelques corrections sans rien retester.

remarque 1

ce code est suffisant, car il s'agit de la même ligne :

            'modification colonne espèces de la ligne du tableau (à partir de la deuxième colonne de la ListBox)
            With Correspondances
                .ListColumns("especes").DataBodyRange.Rows(j) = espèce
                .ListColumns("Correspondance").DataBodyRange.Rows(j) = correspondance
            End With

remarque 2

Si vous voulez la colonne D pour les codes jumeaux, alors il faut modifier .List(.ListIndex, 1) :

         If correspondance = jumeau Then
            Load Modif_jumeau
            Call remplissage_combobox_jumeau(esp?ce)
            Modif_jumeau.Show
            .List(.ListIndex, 2) = Modif_jumeau.Cbx_jumeau
            Unload Modif_jumeau
        End If

remarque 3

au niveau de la recherche dans les BDD complète et synonymes, il faut :

1- préciser la colonne

2- avoir identité sur la colonne de recherche entre le Find et le Findnext

3- la colonne "code" n'existe pas dans la base synonymes

With Bdd_complète
        Set cell = .ListColumns("Code").DataBodyRange.Find(espèce)
        If Not cell Is Nothing Then
            Set cell1 = cell
            Do
                i = cell.Row - .HeaderRowRange.Row
                code = .ListColumns("code").DataBodyRange.Rows(i)
                nom = .ListColumns("NOM_VALIDE").DataBodyRange.Rows(i)

                With Modif_jumeau.Cbx_jumeau
                    .AddItem nom: .List(.ListCount - 1, 1) = code
                End With

                Set cell = .ListColumns("Code").DataBodyRange.FindNext(cell)
            Loop Until cell.Address = cell1.Address
        End If
    End With

    With Bdd_synonymes
        Set cell = .ListColumns("CODE_NOM_VALIDE").DataBodyRange.Find(esp?ce)
        If Not cell Is Nothing Then
            Set cell1 = cell
            Do
                i = cell.Row - .HeaderRowRange.Row
                codeb = .ListColumns("CODE_NOM_COMPLET (synonymes)").DataBodyRange.Rows(i)
                nomb = .ListColumns("NOM_VALIDE").DataBodyRange.Rows(i)
                With Modif_synonymes.Cbx_synonymes
                    .AddItem nomb: .List(.ListCount - 1, 1) = codeb
                End With
                Set cell = .ListColumns("CODE_NOM_VALIDE").DataBodyRange.FindNext(cell)
            Loop Until cell.Address = cell1.Address
        End If
    End With

Encore une fois merci beaucoup !

En adaptant très légèrement ce que vous proposiez, tout fonctionne désormais à merveille ! Tout s'exécute sans encombre et chaque élément va bien à sa place

J'ai beaucoup de chance ayez pris le temps de m'aider !

Désormais, le document est pratiquement terminé. Il me reste à terminer de "cadrer" les codes qui sont enregistrés, pour éviter notamment des mentions "code erroné" qui n'ont pas lieue d'être et finir tester le tout !

Et éventuellement trouver un moyen d'afficher les "codes erronés" dans les textboxes qui s'affichent, mais je ne pense pas que ce soit extrêmement important (si je trouve je viendrai néanmoins poster ma solution à la suite de ce post).

Bonne soirée !

A plus tard

Bonjour,

Après mes différents tests, je me suis retrouvé face à quelques erreurs, dont une que je ne parviens pas à corriger.

Je poste directement à la suite de ce sujet car ça me semble être en lien ; si besoin je créerai un nouveau sujet !

Voici le souci :

Lorsque qu'il y a un code erroné, l'UserForm propose de modifier le code en question. Mais il arrive que le code en question soit remplacé par un synonyme ou un code jumeau. Le code VBA fait bien son travail en renseignant le code synonyme ou jumeau dans la case correspondante.

Une fois le code remplacé, j'exécute un autre code VBA qui me permet d'attribuer une correspondance aux codes qui ont été corrigés (je l'exécutais à la fermeture de l'UserForm).

Là, j'ai un souci :

• Soit je demande une vérification complète, qui va identifier les codes synonymes, codes erronés et codes jumeaux ; mais dans ce cas il apparaîtra toujours "Code synonyme" ou "codes jumeaux" en correspondance (et donc pas la correspondance)
• Soit je demande une vérification incomplète (uniquement les codes erronés) ; là j'ai donc mes correspondances qui apparaissent, sauf pour les codes jumeaux ou synonymes qui se retrouvent classés parmi les "codes erronés".

Je pense que c'est dans cette partie du code VBA là qu'il y a quelque chose à faire, mais sans certitude.

J'ai testé la vérification des codes, durant l'exécution de l'UserForm, avant que les modifications n’apparaissent dans le tableau, l'UF me propose bien de corriger les synonymes lorsque la modification d'un code erroné correspond à un code synonyme ; sauf qu'après il me fait n'importe quoi...

Voici le code de l'UF avec mes modifications :

Option Explicit

Dim Correspondances As ListObject, Bdd_complète As ListObject, Bdd_synonymes As ListObject
Const Erroné As String = "Code erroné"
Const jumeau As String = "Codes jumeaux"
Const Synonymes As String = "Synonymes"

Private Sub CommandButton1_Click()
Unload UserForm3
End Sub

Private Sub UserForm_Initialize()
    Dim espèce As String, correspondance As String
    Dim i As Long

    '// Assignation tableaux structurés
    Set Correspondances = Sheets("Correspondances").ListObjects(1)
    Set Bdd_complète = Sheets("Database complete").ListObjects(1)
    Set Bdd_synonymes = Sheets("Database synonymes complete").ListObjects(1)

    '// Initialisation Listbox des correspondances erronées
    Me.Lbx_correspondances.ColumnCount = 3
    Me.Lbx_correspondances.ColumnWidths = "60"  'Largeur première colonne
    Me.Lbx_correspondances.Clear

    '// remplissage Listbox des correspondances erronnées
With Correspondances
        For i = 1 To .ListRows.Count
            espèce = .ListColumns("especes").DataBodyRange.Rows(i)
            correspondance = .ListColumns("Correspondance").DataBodyRange.Rows(i)
            If correspondance = Erroné Or correspondance = jumeau Or correspondance = Synonymes Then
                With Me.Lbx_correspondances
                    .AddItem i: .List(.ListCount - 1, 1) = espèce: .List(.ListCount - 1, 2) = correspondance
                End With
            End If
        Next i
    End With

End Sub

Private Sub Lbx_correspondances_Click()
    Dim espèce As String, correspondance As String

    With Me.Lbx_correspondances
        espèce = .List(.ListIndex, 1)
        correspondance = .List(.ListIndex, 2)
        If correspondance = Erroné Then
            Modif_erroné.Show
            .List(.ListIndex, 1) = Modif_erroné.Tbx_code
            Unload Modif_erroné
        End If
        If correspondance = jumeau Then
            Load Modif_jumeau
            Call remplissage_combobox_jumeau(espèce)
            Modif_jumeau.Show
            .List(.ListIndex, 2) = Modif_jumeau.Cbx_jumeau
            Unload Modif_jumeau
        End If
        If correspondance = Synonymes Then
            Load Modif_synonymes
            Call remplissage_combobox_synonymes(espèce)
            Modif_synonymes.Show
            .List(.ListIndex, 2) = Modif_synonymes.Cbx_synonymes
            Unload Modif_synonymes
        End If
        End With

End Sub

Sub remplissage_combobox_jumeau(espèce)
    Dim cell As Range, cell1 As Range
    Dim code As String, nom As String
    Dim i As Long

    '// Initialisation Combobox des codes espèce
    Modif_jumeau.Cbx_jumeau.ColumnCount = 2
    Modif_jumeau.Cbx_jumeau.Clear

    '// remplissage Combobox correspondance jumeau
    With Bdd_complète
        'Set cell = .DataBodyRange.Find(espèce)
        Set cell = .ListColumns("Code").DataBodyRange.Find(espèce)
        If Not cell Is Nothing Then
            Set cell1 = cell
            Do
                i = cell.Row - .HeaderRowRange.Row
                code = .ListColumns("code").DataBodyRange.Rows(i)
                nom = .ListColumns("NOM_VALIDE").DataBodyRange.Rows(i)

                With Modif_jumeau.Cbx_jumeau
                    .AddItem nom: .List(.ListCount - 1, 1) = code
                End With

                Set cell = .ListColumns("Code").DataBodyRange.FindNext(cell)
            Loop Until cell.Address = cell1.Address
        End If
    End With
End Sub

Sub remplissage_combobox_synonymes(espèce)

    '// Initialisation Combobox des codes espèce
    Modif_synonymes.Cbx_synonymes.ColumnCount = 2
    Modif_synonymes.Cbx_synonymes.Clear

    Dim cell As Range, cell1 As Range
    Dim codeb As String, nomb As String
    Dim i As Long

    Modif_synonymes.Cbx_synonymes.ColumnCount = 2
    Modif_synonymes.Cbx_synonymes.Clear

    With Bdd_synonymes
        'Set cellb = .DataBodyRange.Find(espèce)
        Set cell = .ListColumns("CODE_NOM_COMPLET (synonymes)").DataBodyRange.Find(espèce)
        If Not cell Is Nothing Then
            Set cell1 = cell
            Do
                i = cell.Row - .HeaderRowRange.Row
                codeb = .ListColumns("CODE_NOM_COMPLET (synonymes)").DataBodyRange.Rows(i)
                nomb = .ListColumns("NOM_VALIDE").DataBodyRange.Rows(i)
                With Modif_synonymes.Cbx_synonymes
                    .AddItem nomb: .List(.ListCount - 1, 1) = codeb
                End With
               ' Set cellb = .ListColumns("Code").DataBodyRange.FindNext(cellb)
                Set cell = .ListColumns("CODE_NOM_COMPLET (synonymes)").DataBodyRange.FindNext(cell)
            Loop Until cell.Address = cell1.Address
        End If
    End With
End Sub

Private Sub Valider_Click()
    Dim i As Integer, j As Long, k As Long, o As Long, p As Long
    Dim espèce As String, correspondance As String

    '// mise à jour des correspondances erronées à partir de la ListBox
    With Me.Lbx_correspondances
        For i = 0 To .ListCount - 1
            'récupération ligne du tableau à partir de la première colonne de la ListBox
            ' et espèce modifiée à partir de la deuxième colonne de la ListBox
            j = .List(i, 0)
            k = .List(i, 0)
            espèce = .List(i, 1)
            correspondance = .List(i, 2)

            Dim derLn&, nb&, derLn2&, nb2&
            Dim dc As Worksheet, ds As Worksheet, co As Worksheet

                Set dc = Sheets("Database complete")
                Set ds = Sheets("Database synonymes complete")
                Set co = Worksheets("Correspondances")
            derLn = dc.Range("A" & Rows.Count).End(xlUp).Row
            derLn2 = ds.Range("A" & Rows.Count).End(xlUp).Row

                    nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), espèce)
                    nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), espèce)

                o = nb2
                p = nb

                If o > 0 Or p = 2 Then
                    Load Modif_jumeau
                    Call remplissage_combobox_jumeau(espèce)
                    Modif_jumeau.Show
                    .List(.ListIndex, 2) = Modif_jumeau.Cbx_jumeau
                    Unload Modif_jumeau
                    Else
                o = 0
                p = 1
                End If

            'mofification colonne espèces de la ligne du tableau (à partir de la deuxième colonne de la ListBox)
            With Correspondances
                .ListColumns("especes").DataBodyRange.Rows(j) = espèce
                .ListColumns("Correspondance").DataBodyRange.Rows(k) = correspondance
            End With
        Next i
    End With
End Sub

Les modifs dont il est question :

            Dim derLn&, nb&, derLn2&, nb2&
            Dim dc As Worksheet, ds As Worksheet, co As Worksheet

                Set dc = Sheets("Database complete")
                Set ds = Sheets("Database synonymes complete")
                Set co = Worksheets("Correspondances")
            derLn = dc.Range("A" & Rows.Count).End(xlUp).Row
            derLn2 = ds.Range("A" & Rows.Count).End(xlUp).Row

                    nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), espèce)
                    nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), espèce)

                o = nb2
                p = nb

                If o > 0 Or p = 2 Then
                    Load Modif_jumeau
                    Call remplissage_combobox_jumeau(espèce)
                    Modif_jumeau.Show
                    .List(.ListIndex, 2) = Modif_jumeau.Cbx_jumeau
                    Unload Modif_jumeau
                    Else
                o = 0
                p = 1
                End If

Elles sont absente du document joint à ce message.

Et voici le code qui me permet de trouver les correspondances ou les erreurs.

Option Explicit

Dim n As String, Rep As Byte
Dim lrfb As Long, lrco As Long, lrsa As Long, lrdc As Long, r As Long
Dim fb As Worksheet, sa As Worksheet, dc As Worksheet, ds As Worksheet, co As Worksheet
Dim rng As Range, cell As Range, rng2 As Range, Cell2 As Range
Dim i&, derLn&, nb&, derLn2&, nb2&
Dim del As Integer

Sub Corresp()

Set fb = Worksheets("Formulaire bota")
Set sa = Worksheets("Saisie")
Set co = Worksheets("Correspondances")
Set dc = Worksheets("Database complete")
Set ds = Worksheets("Database synonymes complete")

                'Compéter la nouvelle colonne "correspondances"
                Dim ii As Integer, vv As Variant
                    Set dc = Sheets("Database complete")
                    Set ds = Sheets("Database synonymes complete")
                    derLn = dc.Range("A" & Rows.Count).End(xlUp).Row
                    derLn2 = ds.Range("A" & Rows.Count).End(xlUp).Row

                    For ii = 2 To co.Range("A" & Rows.Count).End(xlUp).Row
                    Cells(1, 14).Value = ii
                        nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), co.Range("C" & ii))
                        nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), co.Range("C" & ii))
                        If nb = 0 Then
                            If nb2 > 0 Then
                                co.Range("D" & ii) = "Synonymes"
                            ElseIf nb2 = 0 Then
                            co.Range("D" & ii) = "Code erroné"
                            End If
                        ElseIf nb >= 2 Then
                            co.Range("D" & ii) = "Codes jumeaux"
                        ElseIf nb = 1 And nb < 2 And nb <> 0 Then
                            On Error Resume Next
                            vv = Application.WorksheetFunction.VLookup(co.Cells(ii, 3), Sheets("Database complete").Range("A:G"), 7, 0)
                            co.Cells(ii, 4) = IIf(IsError(vv), 0, vv)
                        End If
                    Next ii

End Sub

Je joins un document Excel pour mieux illustrer mon propos, en espérant avoir été assez précis dans ma façon d'expliquer.

En rédigeant ce message, il m'est venu une idée pour solutionner mon problème, je retourne donc à mes tests. Je poste tout de même ce message, histoire de pas le perdre, mais potentiellement mon souci n'en sera peut-être plus un d'ici peu.

A plus tard

Bonne journée !

Je reviens sans solution finalement

Après modifications, les soucis persistent, mais le résultat est presque là...

Lorsque le code erroné modifié est un synonyme, alors un UF avec combobox s'ouvre pour proposer le synonyme qui convient ; le problème c'est qu'il persiste à vouloir s'ouvrir (lorsqu'on clique sur valider) ; ce n'est pas son comportement normal.

Lorsque le code erroné modifié est un code jumeau, alors un UF avec combobox s'ouvre pour proposer une liste de choix vides

Voici le code modifié: :

Option Explicit

Dim Correspondances As ListObject, Bdd_complète As ListObject, Bdd_synonymes As ListObject
Const Erroné As String = "Code erroné"
Const jumeau As String = "Codes jumeaux"
'Aj
Const Synonymes As String = "Synonymes"

Private Sub UserForm_Initialize()
    Dim espèce As String, correspondance As String
    Dim i As Long

    '// Assignation tableaux structurés
    Set Correspondances = Sheets("Correspondances").ListObjects(1)
    Set Bdd_complète = Sheets("Database complete").ListObjects(1)
    Set Bdd_synonymes = Sheets("Database synonymes complete").ListObjects(1)

    '// Initialisation Listbox des correspondances erronées
    Me.Lbx_correspondances.ColumnCount = 3
    Me.Lbx_correspondances.ColumnWidths = "60"  'Largeur première colonne
    Me.Lbx_correspondances.Clear

    '// remplissage Listbox des correspondances erronées
    With Correspondances
        For i = 1 To .ListRows.Count
            espèce = .ListColumns("especes").DataBodyRange.Rows(i)
            correspondance = .ListColumns("Correspondance").DataBodyRange.Rows(i)
            If correspondance = Erroné Or correspondance = jumeau Or correspondance = Synonymes Then
                With Me.Lbx_correspondances
                    .AddItem i: .List(.ListCount - 1, 1) = espèce: .List(.ListCount - 1, 2) = correspondance
                End With
            End If
        Next i
    End With

End Sub

Private Sub Lbx_correspondances_Click()
    Dim espèce As String, correspondance As String

    With Me.Lbx_correspondances
        espèce = .List(.ListIndex, 1)
        correspondance = .List(.ListIndex, 2)
        If correspondance = Erroné Then
            Modif_erroné.Show
            .List(.ListIndex, 1) = Modif_erroné.Tbx_code
            Unload Modif_erroné
        End If
        If correspondance = jumeau Then
            Load Modif_jumeau
            Call remplissage_combobox_jumeau(espèce)
            Modif_jumeau.Show
            .List(.ListIndex, 2) = Modif_jumeau.Cbx_jumeau
            Unload Modif_jumeau
        End If
        If correspondance = Synonymes Then
            Load Modif_synonymes
            Call remplissage_combobox_synonymes(espèce)
            Modif_synonymes.Show
            .List(.ListIndex, 2) = Modif_synonymes.Cbx_synonymes
            Unload Modif_synonymes
        End If
        End With

End Sub

Sub remplissage_combobox_jumeau(espèce)
    Dim cell As Range, cell1 As Range
    Dim code As String, nom As String
    Dim i As Long

    '// Initialisation Combobox des codes espèce
    Modif_jumeau.Cbx_jumeau.ColumnCount = 2
    Modif_jumeau.Cbx_jumeau.Clear

    '// remplissage Combobox correspondance jumeau
    With Bdd_complète
        'Set cell = .DataBodyRange.Find(espèce)
        Set cell = .ListColumns("Code").DataBodyRange.Find(espèce)
        If Not cell Is Nothing Then
            Set cell1 = cell
            Do
                i = cell.Row - .HeaderRowRange.Row
                code = .ListColumns("code").DataBodyRange.Rows(i)
                nom = .ListColumns("NOM_VALIDE").DataBodyRange.Rows(i)

                With Modif_jumeau.Cbx_jumeau
                    .AddItem nom: .List(.ListCount - 1, 1) = code
                End With

                Set cell = .ListColumns("Code").DataBodyRange.FindNext(cell)
            Loop Until cell.Address = cell1.Address
        End If
    End With
End Sub

 'Ajouté

Sub remplissage_combobox_synonymes(espèce)

    '// Initialisation Combobox des codes espèce
    Modif_synonymes.Cbx_synonymes.ColumnCount = 2
    Modif_synonymes.Cbx_synonymes.Clear

    Dim cell As Range, cell1 As Range
    Dim codeb As String, nomb As String
    Dim i As Long

    Modif_synonymes.Cbx_synonymes.ColumnCount = 2
    Modif_synonymes.Cbx_synonymes.Clear

    With Bdd_synonymes
        'Set cellb = .DataBodyRange.Find(espèce)
        Set cell = .ListColumns("CODE_NOM_COMPLET (synonymes)").DataBodyRange.Find(espèce)
        If Not cell Is Nothing Then
            Set cell1 = cell
            Do
                i = cell.Row - .HeaderRowRange.Row
                codeb = .ListColumns("CODE_NOM_COMPLET (synonymes)").DataBodyRange.Rows(i)
                nomb = .ListColumns("NOM_VALIDE").DataBodyRange.Rows(i)
                With Modif_synonymes.Cbx_synonymes
                    .AddItem nomb: .List(.ListCount - 1, 1) = codeb
                End With
               ' Set cellb = .ListColumns("Code").DataBodyRange.FindNext(cellb)
                Set cell = .ListColumns("CODE_NOM_COMPLET (synonymes)").DataBodyRange.FindNext(cell)
            Loop Until cell.Address = cell1.Address
        End If
    End With
End Sub

Private Sub Valider_Click()
    Dim i As Integer, j As Long, k As Long
    Dim espèce As String, correspondance As String

    '// mise à jour des correspondances erronées à partir de la ListBox
    With Me.Lbx_correspondances
        For i = 0 To .ListCount - 1
            'récupération ligne du tableau à partir de la première colonne de la ListBox
            ' et espèce modifiée à partir de la deuxième colonne de la ListBox
            j = .List(i, 0)
            k = .List(i, 0)
            espèce = .List(i, 1)
            correspondance = .List(i, 2)

            'mofification colonne espèces de la ligne du tableau (à partir de la deuxième colonne de la ListBox)
            With Correspondances
                .ListColumns("especes").DataBodyRange.Rows(j) = espèce
                .ListColumns("Correspondance").DataBodyRange.Rows(k) = correspondance
            End With
        Next i
    End With

Dim ii As Integer, vv As Variant
Dim co As Worksheet, dc As Worksheet, ds As Worksheet
Dim lrco As Long, o As Long, p As Long
Dim derLn&, nb&, derLn2&, nb2&

                Set dc = Sheets("Database complete")
                Set ds = Sheets("Database synonymes complete")
                Set co = Worksheets("Correspondances")

                    derLn = dc.Range("A" & Rows.Count).End(xlUp).Row
                    derLn2 = ds.Range("A" & Rows.Count).End(xlUp).Row

                    nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), espèce)
                    nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), espèce)
                        o = nb2
                        p = nb

                    With Me.Lbx_correspondances
                        espèce = .List(.ListIndex, 1)
                        correspondance = .List(.ListIndex, 2)

                        For ii = 2 To co.Range("A" & Rows.Count).End(xlUp).Row

                        If p = 0 Then
                            If o > 0 Then 'And Cells(ii, 4).Value = "Synonymes"
                                co.Range("D" & ii) = "Synonymes"
                                Load Modif_synonymes
                                Call remplissage_combobox_synonymes(espèce)
                                Modif_synonymes.Show
                                .List(.ListIndex, 2) = Modif_synonymes.Cbx_synonymes
                                Unload Modif_synonymes
                                o = 0
                            End If
                        ElseIf p >= 2 Then 'And Cells(ii, 4).Value = "Codes jumeaux"
                                co.Range("D" & ii) = "Codes jumeaux"
                                Load Modif_jumeau
                                Call remplissage_combobox_jumeau(espèce)
                                Modif_jumeau.Show
                                .List(.ListIndex, 2) = Modif_jumeau.Cbx_jumeau
                                Unload Modif_jumeau
                                p = 1
                        ElseIf p = 1 And p < 2 And p <> 0 Then
                            On Error Resume Next
                            vv = Application.WorksheetFunction.VLookup(co.Cells(ii, 3), Sheets("Database complete").Range("A:G"), 7, 0)
                            co.Cells(ii, 4) = IIf(IsError(vv), 0, vv)
                        End If
                    Next ii
                    End With
End Sub

Et juste la partie mise à jour :

Dim ii As Integer, vv As Variant
Dim co As Worksheet, dc As Worksheet, ds As Worksheet
Dim lrco As Long, o As Long, p As Long
Dim derLn&, nb&, derLn2&, nb2&

                Set dc = Sheets("Database complete")
                Set ds = Sheets("Database synonymes complete")
                Set co = Worksheets("Correspondances")

                    derLn = dc.Range("A" & Rows.Count).End(xlUp).Row
                    derLn2 = ds.Range("A" & Rows.Count).End(xlUp).Row

                    nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), espèce)
                    nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), espèce)
                        o = nb2
                        p = nb

                    With Me.Lbx_correspondances
                        espèce = .List(.ListIndex, 1)
                        correspondance = .List(.ListIndex, 2)

                        For ii = 2 To co.Range("A" & Rows.Count).End(xlUp).Row

                        If p = 0 Then
                            If o > 0 Then 'And Cells(ii, 4).Value = "Synonymes"
                                co.Range("D" & ii) = "Synonymes"
                                Load Modif_synonymes
                                Call remplissage_combobox_synonymes(espèce)
                                Modif_synonymes.Show
                                .List(.ListIndex, 2) = Modif_synonymes.Cbx_synonymes
                                Unload Modif_synonymes
                                o = 0
                            End If
                        ElseIf p >= 2 Then 'And Cells(ii, 4).Value = "Codes jumeaux"
                                co.Range("D" & ii) = "Codes jumeaux"
                                Load Modif_jumeau
                                Call remplissage_combobox_jumeau(espèce)
                                Modif_jumeau.Show
                                .List(.ListIndex, 2) = Modif_jumeau.Cbx_jumeau
                                Unload Modif_jumeau
                                p = 1
                        ElseIf p = 1 And p < 2 And p <> 0 Then
                            On Error Resume Next
                            vv = Application.WorksheetFunction.VLookup(co.Cells(ii, 3), Sheets("Database complete").Range("A:G"), 7, 0)
                            co.Cells(ii, 4) = IIf(IsError(vv), 0, vv)
                        End If
                    Next ii
                    End With

Et le document joint mis à jour.

Si vous avez une idée..

Merci de votre attention,

Bonne journée !

Le Drosophile a écrit :

Après modifications, les soucis persistent,

Après test de votre dernière version, je n'ai pas les 2 soucis que vous signalez.

Ah ! C'est normal, j'ai oublié de préciser la démarche...

Pour le premier code, il faut rentrer dans la Textbox :

Dact glom ssp. Glom (pour remplacer Dacr glom ssp. Glom)

Et pour la dernière : remplacer lolu arun par loli arun.

A plus tard !

Bonjour,

J'ai essayé de modifié l'ordre de lancement des codes et diverses "solutions" ; sans succès pour le moment.

Je joint à nouveau mon document pour faire apparaître les quelques modifications.

Pour le moment je ne vois pas comment m'y prendre.

Pour voir les erreurs il suffit d'inscrire, en remplacement d'un code erroné, un code synonyme ; par exemple "Loli arun".

On peut aussi faire le test en remplaçant un code erroné par un "Code jumeau" ; exemple : "Rese lute".

Que ce soit pour l'un ou pour l'autre, le remplacement pose problème.

- Soit je demande à remplacer le code par le nouveau code ; exemple : Rese lute.

Là je demande à ce qu'Excel revérifie si Rese lute est un code valide ou un code jumeau => Code jumeau ; l'UserForm s'ouvre à nouveau et là je peux modifier ; sauf que dès qu'il y a revérification (ce qui peut arriver ; c'est comme ça que je l'ai découvert d'ailleurs) la correspondance est alors à nouveau passée en "Codes jumeaux" et ça indéfiniment.

- Soit je demande à faire une vérification avant modification, de manière à ce que l'UF me propose de modifier Rese lute directement après qu'on ait modifié le code erroné. Mais je n'y suis pas parvenu.

Il restera peut-être la solution de passer par 3 colonnes...

Bonne journée !

Il s'agit du dernier problème touchant mon document, a priori, mais je ne trouve toujours pas de moyen pour y remédier.

Bonjour,

Problème résolu.

Je m'y suis finalement pris autrement en fermant et rechargeant l'UserForm ; ça marche bien pour le moment.

Voici le code en question qui s'inscrit à la place du précédent "Private Sub Valider_Click()"

Private Sub Valider_Click()
    Dim i As Integer, j As Long, k As Long
    Dim espèce As String, correspondance As String, corresp As String

    '// mise à jour des correspondances erronées à partir de la ListBox
    With Me.Lbx_correspondances
        For i = 0 To .ListCount - 1
            'récupération ligne du tableau à partir de la première colonne de la ListBox
            ' et espèce modifiée à partir de la deuxième colonne de la ListBox
            j = .List(i, 0)
            k = .List(i, 0)
            espèce = .List(i, 1)
            correspondance = .List(i, 2)

            'mofification colonne espèces de la ligne du tableau (à partir de la deuxième colonne de la ListBox)
            With Correspondances
                .ListColumns("especes").DataBodyRange.Rows(j) = espèce
                .ListColumns("Correspondance").DataBodyRange.Rows(k) = correspondance
            End With
        Next i
    End With

Dim derLn&, nb&, derLn2&, nb2&
Dim ii As Integer, vv As Variant
    Set dc = Sheets("Database complete")
    Set ds = Sheets("Database synonymes complete")
    Set co = Worksheets("Correspondances")

        derLn = dc.Range("A" & Rows.Count).End(xlUp).Row
        derLn2 = ds.Range("A" & Rows.Count).End(xlUp).Row

    For ii = 2 To co.Range("A" & Rows.Count).End(xlUp).Row
        nb = WorksheetFunction.CountIfs(dc.Range("A2:A" & derLn), co.Range("C" & ii))
        nb2 = WorksheetFunction.CountIfs(ds.Range("B2:B" & derLn2), co.Range("C" & ii))

            If nb >= 2 And co.Range("D" & ii) = "Code erroné" Then
                    co.Range("D" & ii) = "Codes jumeaux"
            ElseIf nb = 1 And nb < 2 And nb <> 0 And co.Range("D" & ii) = "Code erroné" Then
            On Error Resume Next
                vv = Application.WorksheetFunction.VLookup(co.Cells(ii, 3), Sheets("Database complete").Range("A:G"), 7, 0)
                co.Cells(ii, 4) = IIf(IsError(vv), 0, vv)
            End If
            If nb = 0 And nb2 > 0 And co.Range("D" & ii) = "Code erroné" Then
                    co.Range("D" & ii) = "Synonymes"
            If nb = 0 And nb2 = 0 Then
                    co.Range("D" & ii) = "Code erroné"
                End If
            End If

    Next
style
UserForm3.Hide 'ou Unload Userform3

Dim lrco As Long
    lrco = co.Cells(Rows.Count, 1).End(xlUp).Row

    Dim Plageb As Range
    Dim Cibleb, Cible2b, Cible3b
    Set Plageb = co.Range("D1:D" & lrco)
    On Error Resume Next
    Cibleb = Application.WorksheetFunction.CountIf(Plageb, "=Code erroné")
    Cible2b = Application.WorksheetFunction.CountIf(Plageb, "=Codes jumeaux")
    Cible3b = Application.WorksheetFunction.CountIf(Plageb, "=Synonymes")
    If Cibleb + Cible2b + Cible3b > 0 Then UserForm3.Show
End Sub

Un très grand merci encore pour l'aide apportée en début de discussion ! Je suis vraiment content d'arriver au bout de ce projet !

Bonne fin de journée !