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

lusert

XLDnaute Junior
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 latinNom FrançaisIDFamilleectectect
Picus viridisPic Vert4562Picidésectectect
Parus majorectectectectectect

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)))
1234
Nom latinnom latinNom francaisIdFamille
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 vert4562Picidé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
 
Solution
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)...

lusert

XLDnaute Junior
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 ^^
 

lusert

XLDnaute Junior
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 ;)
 

Pièces jointes

  • Utiliser mise en forme de saisie samsung, enleve ; et repartit mot par cellule.xlsm
    18.8 KB · Affichages: 6
  • Range 1 mot par cellule mot par cellule apres suppression des pt virgules.xlsm
    24.1 KB · Affichages: 5

lusert

XLDnaute Junior
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
 

Pièces jointes

  • Fiche_de_Saisie_INPN_rendu_base_de_donnees - Copie.xlsm
    250.6 KB · Affichages: 5

lusert

XLDnaute Junior
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.
 

Discussions similaires