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 !
- Messages
- 4'087
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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 !
- Messages
- 4'087
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
- Messages
- 4'087
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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.
- Messages
- 4'087
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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 !
- Messages
- 4'087
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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 !
- Messages
- 4'087
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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 !