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

L

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
sylvanu
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)...
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re

•>lusert
Comme je le disais (message#3), on peut se contenter d'une version allégée de ton fichier
(et alors tu pourras la joindre directement sur le forum)
Tu as regardé la proposition soumise par Roblochon?
PS: J'ai bien vu que tu avais fini par me voir ;)
 
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
Je n'ai pas bien compris la fonction que Roblochon a mis en place. vraiment désolé de mon ignorance ^^ je suis plus fais pour faire du terrain, identifier les animaux.

=SUBSTITUE(@CELLULE("nomfichier";$A$1);"Bombus.xlsx"; "BDC_STATUTS_13.csv")
Base de données :C:\Users\luser\AppData\Local\Temp\BDC_STATUTS_13.csv
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
En PJ un exemple à adapter à votre fichier.
A noter que je l'ai réduit à 40 lignes. C'est suffisant pour bosser, et valider le principe.
On lance la macro par appui sur le bouton orange.
VB: 
Sub RapatrieParametres()
Dim Derlig As Long, IndexL As Long, L As Long, C As Long
Application.ScreenUpdating = False
Derlig = Application.WorksheetFunction.CountA(Range("A1:A1000000"))
For L = 2 To Derlig
    If Not IsError(Application.Match(Cells(L, 1), Sheets("BD_Insectes").Range("A1:A1000000"), 0)) Then
        IndexL = Application.Match(Cells(L, 1), Sheets("BD_Insectes").Range("A1:A1000000"), 0)
        For C = 1 To 40
            Cells(L, C + 1) = Sheets("BD_Insectes").Cells(IndexL, C)
        Next C
    End If
Next L
End Sub
 

Pièces jointes

  • fiche_saisie_macrolikerecherchV_V2.xlsm
    29.8 KB · Affichages: 11
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
C:\Users\luser\OneDrive\Documents\MODELS_OUTILS de travail\Modèle Excel\TAXREF\Groupes_Taxonomique_Métropole_csv\[fiche_saisie_macrolikerecherchV.xlsm]BD_Insectes
sylvanu à dit:
Re,
En PJ un exemple à adapter à votre fichier.
A noter que je l'ai réduit à 40 lignes. C'est suffisant pour bosser, et valider le principe.
On lance la macro par appui sur le bouton orange.
VB: 
Sub RapatrieParametres()
Dim Derlig As Long, IndexL As Long, L As Long, C As Long
Application.ScreenUpdating = False
Derlig = Application.WorksheetFunction.CountA(Range("A1:A1000000"))
For L = 2 To Derlig
    If Not IsError(Application.Match(Cells(L, 1), Sheets("BD_Insectes").Range("A1:A1000000"), 0)) Then
        IndexL = Application.Match(Cells(L, 1), Sheets("BD_Insectes").Range("A1:A1000000"), 0)
        For C = 1 To 40
            Cells(L, C + 1) = Sheets("BD_Insectes").Cells(IndexL, C)
        Next C
    End If
Next L
End Sub
Cliquez pour agrandir...

Génialissime!

Ça fonctionne comme dans mes rêves.


Je vais maintenant adapter la macro pour quelle prenne en compte les 15000 autres données de la feuille bd insecte
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Ce sera automatique.
VB: 
Sheets("BD_Insectes").Range("A:A")
La ligne Derlig prend toute la base de données jusqu'à la dernière ligne.
Il faut juste toucher à : Sheets("BD_Insectes") pour les autres bases.
D'ailleurs, il y a plus simple :
Code: 
Sub RapatrieParametres()
' Changez le nom de la base utilisée
Base = "BD_Insectes"
'-------------------------------------------------------
Dim Derlig As Long, IndexL As Long, L As Long, C As Long
Application.ScreenUpdating = False
Derlig = Application.WorksheetFunction.CountA(Range("A:A"))
For L = 2 To Derlig
    If Not IsError(Application.Match(Cells(L, 1), Sheets(Base).Range("A:A"), 0)) Then
        IndexL = Application.Match(Cells(L, 1), Sheets(Base).Range("A:A"), 0)
        For C = 1 To 40
            Cells(L, C + 1) = Sheets(Base).Cells(IndexL, C)
        Next C
    End If
Next L
End Sub
Vous n'avez juste à changer le nom de la base utilisée : Base=xxxxxx
et ne toucher à rien d'autres. ;)
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

•>sylvanu
Une question en passant
Ca ne fonctionnera pas ainsi aussi?
(non testé, d'où ma question ;))
VB: 
Sub RapatrieParametres()
Dim Derlig As Long, IndexL As Long, L As Long, C As Long
Application.ScreenUpdating = False
Derlig = Application.WorksheetFunction.CountA(Range("A1:A1000000"))
For L = 2 To Derlig
IndexL = Application.Match(Cells(L, 1), Sheets("BD_Insectes").Range("A1:A1000000"), 0)
    If Not IsError(IndexL) Then
        For C = 1 To 40
            Cells(L, C + 1) = Sheets("BD_Insectes").Cells(IndexL, C)
        Next C
    End If
Next L
End Sub
 
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
Super ! Encore merci !
J'ai pu ajouter déjà pour la première version de macro les 10000 données et je vais tenter d'appliquer votre nouveau code vba pour voir ce que cela va donner.

Au vue de vos derniers messagesn j'ai l'impression d'avoir loupé un épisode. Le fichier quevous m'avez transmis, semble fonctionner, en tout cas quand j'écris de nouveaux nom d'espèces et que je clique sur le bouton alors il apparait les champs de correspodance
 
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
Merci à tous les deux !

J'ai donc tester ces 3 différents codes VBA et ils fonctionnent super bien même avec plus de 150 000 ligne en BD.
Par contre je n'ai pas bien saisie où je devrais rajouter ce code : Sheets("BD_Insectes").Range("A:A")

afin que comme vous dites ça soit automatique ? IL faut ramplacer cette ligne ci-dessous si je comprends bien ?
Sheets("BD_Insectes").Range("A1:A1000000"),
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Si vous avez pris le code du post #21 vous n'avez rien à faire. C'était en réponse à votre post :
Je vais maintenant adapter la macro pour quelle prenne en compte les 15000 autres données de la feuille bd insecte
Cliquez pour agrandir...
Je disais que vous n'avez rien à faire puisque celle ligne s'en charge. ( recherche de l'ensemble des lignes )
Sur le code du post #21 vous n'avez juste qu'à changer :
VB: 
Base = "BD_Insectes"
par, par exemple :
Base = "BD_Oiseaux"
et rien d'autre.
Il vous faut donc une macro par base de données. ( il suffit de faire un copier coller et de changer le nom.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

•>sylvanu
Je ne sais pas si c'est orthodoxe, mais cela fonctionne, non?
VB: 
Sub RapatrieParametres()
Dim Derlig As Long, IndexL As Long, L As Long, C As Long
Application.ScreenUpdating = False
Derlig = Application.WorksheetFunction.CountA(Range("A1:A1000000"))
With Sheets("BD_Insectes")
    For L = 2 To Derlig
    On Error Resume Next
    IndexL = Application.Match(Cells(L, 1), .Range("A1:A1000000"), 0)
        If Not IsError(IndexL) Then
            For C = 1 To 40
                Cells(L, C + 1) = .Cells(IndexL, C)
            Next C
        End If
    Next L
End With
End Sub
(je viens de tester sur ton fichier exemple ;))
 
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
J'ai pu tester cette dernière macro. Elle fonctionne aussi bien que les autres.
Je crois qu'avec toutes ces informations, il est maintenant inutile de continuer à alimenter le fil de la discutions. Je m'en vais de ce pas trouver comme clôture la discutions.

Encore merci pour les différentes solutions proposées
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 
Vote positif 0 Vote négatif
Solution

Discussions similaires

R
  • Question
Autres Traitement Client Excel - Google Sheet
Réponses
5
Affichages
234
sylvanu
sylvanu
P
  • Question
Microsoft 365 Tableau et condition inclusive comptabilité par mois
Réponses
1
Affichages
134
merinos
merinos
A
  • Question
XL 2019 Variable du bureau dans l'envoie par Outlook Filename:= et .Attachments.Add
Réponses
11
Affichages
409
fanch55
fanch55
L
  • Question
Microsoft 365 Userform : Combobox triée/sans doublons avec saisie intuitive/recherche multimots
Réponses
8
Affichages
2 K
AtTheOne
AtTheOne
V
  • Question
Microsoft 365 Valeur rechercher selon plusieurs critères et sur plusieurs pages par rapport à une cellule
Réponses
12
Affichages
1 K
Varona Rodriguez
V
W
  • Question
XL 2010 [VBA] Filtre et extraction données [RESOLU]
Réponses
7
Affichages
3 K
Lolote83
L
V
  • Question
Problème correspondance Valeur et Textbo d'un userform
Réponses
2
Affichages
2 K
VOILLOT
V
T
  • Question
[RESOLU] Code VBA pour supprimer lignes et colonnes
2
Réponses
15
Affichages
2 K
tamatave33
T
B
  • Question
[RESOLU] [VBA] Problème pour remplacer les points par rien
2
Réponses
24
Affichages
7 K
benzeboss
B
MikeBelgique
  • Question
problème vba suite migration 2003 vers 2010
2
Réponses
20
Affichages
3 K
MikeBelgique
MikeBelgique

Membres actuellement en ligne

19 membres et 196 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 194
Messages
2 086 066
Membres
103 110
dernier inscrit
Privé