XL 2019 PRESQUE RESOLU : Remplacer RecherchV complexe pour correspondance INPN et cardobs par VBA

lusert · 21 Avril 2020

Bonjour à tous !

Je m'adresse aujourd'hui à vous car malgré de nombreuses recherche, je n'arrive pas à trouver de solution à mon problème.

Pour me faciliter la retranscription des espèces que j'observe, je mets en lien le fichier Taxref et le fichier ou j'ai saisie mes noms d'espèces animales.
Ce fichier taxref est ma base de donnéeil y a plus de 200 000 lignes. Il se compose d'une colonne A avec toutes les espèces de france et de 20 autres colonnes (de B à AA) composé des champs de correspondance à l'espèce (par exemple A : Pic vert et en trouve en B : la famille de l'oiseaux et en C : en iddentifiant... ainsi de suite).

Nom latin	Nom Français	ID	Famille	ect	ect	ect
Picus viridis	Pic Vert	4562	Picidés	ect	ect	ect
Parus major	ect	ect	ect	ect	ect	ect

Mon deuxième fichier correspondant aux espèces que j'ai observé, il y a donc une seul colonne de rempli de nom d'espèces et je souhaite que les colonne de B à AA soient complété par la formule recherchV (que vous pouvez lire en cellule B3 =SI(ESTNA(RECHERCHEV($A3;BD!$A$2:$H$12;B$1;FAUX));;(RECHERCHEV($A3;BD!$A$2:$H$12;B$1;FAUX)))

	1	2	3	4
Nom latin	nom latin	Nom francais	Id	Famille
Picus viridis	=SI(ESTNA(RECHERCHEV($A3;BD!$A$2:$H$12;B$1;FAUX));;(RECHERCHEV($A3;BD!$A$2:$H$12;B$1;FAUX)))	Pic vert	4562	Picidés

Avec cette formule je peux aisément trouver les champs de correspondances aux espèces que j'ai observé afin d'être au norme avec la directive INPN.
Le problème c'est que ma base de donnée est lourde, très lourdes et que ce retrouver avec plus de 500 liaisons, ça rend les mises à jours de sliasions ou des enregistrement assez long ( 15 à 25 mn d'attente).

Je me suis donc inspiré de cette macro ci-dessous, extraite d'un fichier excel modèle d'un forum mais j'ai oublié lequel)

Sub Bouton1_Cliquer()
For i = 2 To 1000
Range("M" & i) = WorksheetFunction.VLookup(Range("e" & i), Range("$a$2:$c$1000"), 3)
Next i
End Sub

Elle fonctionne mais que sur une seul et même feuille et on ne peut pas faire apparaître plus d'une colonne de correspondance.
Je suis pas assez doué pour comprendre comment transposé ma formule =SI(ESTNA(RECHERCHEV($A3;BD!$A$2:$H$12;B$1;FAUX));;(RECHERCHEV($A3;BD!$A$2:$H$12;B$1;FAUX))) en macro avec un bouton à cliquer.

Si vous avez des pistes je vous en remercierez 1000 fois car je sèche complément sur ce sujet.

Cordialement,

ps : je peux joindre mon fichier excel pour aider à visualiser mon problème

Lusert

sylvanu · 21 Avril 2020

Re, ça marche mais un peu bidouillée, mais en tout cas surement plus rapide.
Un savant mix up de nos deux solutions permettant de simplifier la vie à Lusert sur la base utilisée:

Code:

Sub RapatrieParametres()
Dim Derlig As Long, IndexL As Long, L As Long, C As Long, Base As String
' Declarer base à utiliser
Base = "BD_Insectes"
'-------------------------
Application.ScreenUpdating = False
Derlig = Application.WorksheetFunction.CountA(Range("A:A"))
With Sheets(Base)
    For L = 2 To Derlig
        IndexL = 0
        On Error Resume Next
        IndexL = Application.Match(Cells(L, 1), .Range("A:A"), 0)
        If Not IsError(IndexL) And IndexL <> 0 Then
            For C = 1 To 40
                Cells(L, C + 1) = .Cells(IndexL, C)...

Staple1600 · 21 Avril 2020

Re

•>lusert
[Pour infos]
Sache que pour moi, une discussion n'est jamais clôturée
ou une question jamais résolue
En effet, il y aura toujours N façon de solutionner une question.

lusert · 21 Avril 2020

sylvanu à dit:
Re, ça marche mais un peu bidouillée, mais en tout cas surement plus rapide.
Un savant mix up de nos deux solutions permettant de simplifier la vie à Lusert sur la base utilisée:

Code:

Sub RapatrieParametres() Dim Derlig As Long, IndexL As Long, L As Long, C As Long, Base As String ' Declarer base à utiliser Base = "BD_Insectes" '------------------------- Application.ScreenUpdating = False Derlig = Application.WorksheetFunction.CountA(Range("A:A")) With Sheets(Base) For L = 2 To Derlig IndexL = 0 On Error Resume Next IndexL = Application.Match(Cells(L, 1), .Range("A:A"), 0) If Not IsError(IndexL) And IndexL <> 0 Then For C = 1 To 40 Cells(L, C + 1) = .Cells(IndexL, C) Next C End If Next L End With End Sub

L'astuce à rajouter est IndexL=0, sinon s'il ne trouve pas le Resume Next laisse à IndexL la valeur précédente.

Lusert, prenez cette macro collégiale, elle est plus rapide.

Ok ! alors je conserve celle-ci ! En vrai vous m'avez perdu avec toutes ses solutions ^^

Staple1600 · 21 Avril 2020

Re

C'est normal.
Cela sert à cela, le confinement
Se perdre dans VBA et dans Excel pour en tirer la substantifique moelle

lusert · 21 Avril 2020

Maitenant que la solution a été identifié est colorisé en vert, comment fait t-on pour mettre fin à la discutions pour ne pas rajouter plus d'info ?

Staple1600 · 21 Avril 2020

Re

Ce n'est pas possible
Seul le modérateur du site a ce pouvoir.

lusert · 27 Avril 2020

Bonsoir à tous

Le fichier a été vraiment bien exploité ces derniers jours.
Je le rencontre que ce fichier à l'aide de ma macro pourrait me simplifier la vie pour un autre sujet qui est la restitution de ces données naturaliste mise à jour et structuré selon les champs INPN. Pour ce faire dans la macro j'ai décalé l'emplacement de la macro de 40 lignes.
j'ai remplacé le 1 par 40 de Cells(L, C + 1) = .Cells(IndexL, C).
Maintenant je peux associer à ces 39 lignes vide (vu que la première ligne comporte ma liste d'espèces) les colonnes de relevés de terrain (champs date, commune...)

Il se semble que je rencontre un petit problème par rapport à ces champ à ajouter.
Quand je saisie sur téléphone mes noms d'espèces je suis obligé d'avoir des nom ou les espaces sont remplacé par le tiret du 8 (_) et des fois par inadvertance j'acrit plusieurs nom dan sune même cellule, où chauque nom est séparé par un point virgule (. J'ai trouvé des macro qui faisait soit ses étapes de manières individuel (pour mettre en forme la liste destiné à la macro
Sub RapatrieParametres() où bien je tmobe sur des macro complet (que je place dans un autre
bouton) mais ça me bousille la mise en forme de ma première macro.

Es-ce que vous avez des idées sur ce sujet ? Je vous ai joint deux exemples de macro que j’aimerai associer à mon document mais qui me font tourner en bourrique.

ps : Je me suis aperçu que j'ai oublié de mentionner qu'il fallait ajouter des mot avec / ou \ pour voir la macro fonctionner. L'une a un bouton,, l'autre il faut cliquer deux fois

sylvanu · 27 Avril 2020

Bonjour Lusert,
Envoyez plutôt un fichier exemple de votre fichier modifié, ainsi que des chaines qu'on peut rencontrer et où les ranger.

lusert · 28 Avril 2020

sylvanu à dit:
Bonjour Lusert,
Envoyez plutôt un fichier exemple de votre fichier modifié, ainsi que des chaines qu'on peut rencontrer et où les ranger.

Ah ! ok ! Voila le fichier ci-dessous. J'ai intégrer une feuille info avec la macro actuel utilisé et les modif que j'y est inscrites plus deux exemple de macro que j'aimerais pouvoir y intégrer.

Je vois pas trop comment procéder ? mais si ça fonctionne alors le monde du vba est vraiment chouette

lusert · 11 Mai 2020

Rebonjour à tous !

Je me suis repenché sur la macro, maintenant que je comprend un peu mieux les fonctionnalités !
J'ai tenté cette fois ci d'intégrer une deuxième table de donnée, extraite de Taxref HUB, qui me permet de connaitre en nplus des taxonomie, les protection au niveau de tel ou tel espèce ci-dessous https://taxref.mnhn.fr/taxref-web/api/webservice

La seul solution que j'ai trouvé a été de crée deux module, 1 module par base de donnée et de modifier la plage de collage à ce niveau là : For C = 1 To 40 Cells(L, C + 40) = .Cells(IndexL, C)

C'est une méthode qui marche mais je me demande si il n'y a pas possibilité de fusionner les deux macro pour dire l'un se base la colonne 1 (A) des noms d 'espèces puis sur la colonne 12 des cd_nom qui apparaissent grâce à la première étape de la macro.

XL 2019 PRESQUE RESOLU : Remplacer RecherchV complexe pour correspondance INPN et cardobs par VBA

lusert

XLDnaute Junior

sylvanu

Staple1600

XLDnaute Barbatruc

lusert

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

lusert

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

lusert

XLDnaute Junior

Pièces jointes

sylvanu

XLDnaute Barbatruc

lusert

XLDnaute Junior

Pièces jointes

lusert

XLDnaute Junior

Discussions similaires