XL 2013 Recherche filtrée avec un test et entre deux feuilles

FMDCC · 11 Avril 2018

Bonjour,

Je bloque sur la mise en place d'un traitement qui me permettrait de faire une recherche filtrée entre deux feuilles et avec également un test.
Je m'explique, tout d'abord, j'ai 2 bases de données contenant des adresses et pour chaque ligne un nombre de logements. La seconde possède en plus un champ renseignant son code parcelle. C'est donc ce champs que je veux ajouter à ma BD 1.

Sur ma première feuille (où se trouve la BD 1), je souhaite après avoir cliqué sur un bouton, lancer un traitement qui recherche pour chaque adresse de cette feuille, parmi les adresses en DB 2 celles strictement similaires et pour laquelle la différence en nombre de logements est la moindre. Puis renvoie le code parcelle correspondant en colonne C de la feuille BD 1.

Etant donné le grand nombre d'adresses présentent en BD 2 (dans mes données pas dans cet exemple bien sûr !), j'aimerai que le traitement identifie dans un premier temps le code INSEE pour faire la recherche de l'adresse uniquement sur les adresses de cette commune et non sur l'ensemble.

Voici un fichier exemple :
Exemple.xlsm

J'aimerai également que le traitement se fasse (si possible) sans avoir recourt à l'utilisation de nouvelle feuille.

Si je n'ai pas été clair sur un point n'hésitez pas à me demander plus de précisions.

Merci beaucoup

Nairolf · 13 Avril 2018

En fait la formule est un peu plus compliquée :

VB:

Adresses_Majic = Range(ActiveWorkbook.Names("Code_INSEE").RefersTo).Value

Quelques modifications dans ton code:

VB:

Sub Traitement()

Dim Ecart_en_cours, Nb_adresses_a_trouver, i, j As Long
Dim Adresses_BD2()
Dim Adresses_a_trouver_BD1()

Dim Nb_logs_BD1()
Dim Code_INSEE, Resultat As String

Nb_adresses_a_trouver = Sheets("BD 1").Cells(Rows.Count, "C").End(xlUp).Row - 3
Adresses_a_trouver_BD1 = Worksheets("BD 1").Range("AZ4:AZ" & Nb_adresses_a_trouver + 3).Value
Nb_logs_BD1 = Worksheets("BD 1").Range("C4:C" & Nb_adresses_a_trouver + 3).Value

'Parcours l'ensemble des adresses de copros à rechercher
For i = 1 To Nb_adresses_a_trouver
    Resultat = "Pas de lien"
    Ecart_en_cours = 1000000
   
    'Rempli Adresses_BD2 avec les adresses en fonction du code INSEE de l'adresse à trouver
   
    Code_INSEE = "com_" & Right(Application.Index(Adresses_a_trouver_BD1, i, 1), 5)
    Adresses_BD2 = Range(ActiveWorkbook.Names(Code_INSEE).RefersTo).Value

    For j = LBound(Adresses_BD2) To UBound(Adresses_BD2)
        If Adresses_BD2(j, 1) = Adresses_a_trouver_BD1(i, 1) Then
            If Abs(Adresses_BD2(j, 3) - Nb_logs_BD1(i, 1)) < Ecart_en_cours Then
                Ecart_en_cours = Abs(Adresses_BD2(j, 3) - Nb_logs_BD1(i, 1))
                Resultat = Adresses_BD2(j, 2)
            End If
        End If
    Next j
   
    Worksheets("BD 1").Cells(i + 3, 53) = Resultat

Next i

End Sub

FMDCC · 13 Avril 2018

Merci pour cette solution.
Entre temps, je mettais rendu compte de pas mal d'erreurs bêtes dans mon dernier envoi (erreur dans le nom de certaines variables, inversion entre colonne et ligne, ... ).

Visiblement, sur mon fichier exemple (13 avril) ça à l'air de bien fonctionner sauf sur les deux premières adresses en BD1 qui n'ont pas été traitées.

FMDCC · 13 Avril 2018

Et voici le fichier avec une correction dans le code pour bien travailler sur l'ensemble des adresses en BD 1.

Encore un grand merci à toi Nairolf !

Je testerai la semaine prochaine sur ma base de données complète et te ferai un retour sur le temps d'exécution même si à priori avec ces différentes plages par communes en BD2, je pense que le traitement devrait être plutôt rapide.

Nairolf · 16 Avril 2018

Salut une autre adaptation de ma réponse précédente traitement du résultat par tableau monocolonne (normalement plus rapide qu'une boucle, mais à vérifier):

VB:

Sub Traitement()

Dim Ecart_en_cours, Nb_adresses_a_trouver, i, j As Long
Dim Adresses_BD2()
Dim Adresses_a_trouver_BD1()
Dim Code_parcelle_BD1() '''ajout
Dim Nb_logs_BD1()
Dim Code_INSEE ''', Resultat As String

Nb_adresses_a_trouver = Sheets("BD 1").Cells(Rows.Count, "C").End(xlUp).Row - 3
Adresses_a_trouver_BD1 = Worksheets("BD 1").Range("AZ4:AZ" & Nb_adresses_a_trouver + 3).Value
Nb_logs_BD1 = Worksheets("BD 1").Range("C4:C" & Nb_adresses_a_trouver + 3).Value

ReDim Code_parcelle_BD1(1 To Nb_adresses_a_trouver) '''ajout

'Parcours l'ensemble des adresses de copros à rechercher
For i = 1 To Nb_adresses_a_trouver
    '''Resultat = "Pas de lien"
    Code_parcelle_BD1(i) = "Pas de lien" '''ajout
    Ecart_en_cours = 1000000
   
    'Rempli Adresses_BD2 avec les adresses en fonction du code INSEE de l'adresse à trouver
   
    Code_INSEE = "com_" & Right(Application.Index(Adresses_a_trouver_BD1, i, 1), 5)
    Adresses_BD2 = Range(ActiveWorkbook.Names(Code_INSEE).RefersTo).Value

    For j = LBound(Adresses_BD2) To UBound(Adresses_BD2)
        If Adresses_BD2(j, 1) = Adresses_a_trouver_BD1(i, 1) Then
            If Abs(Adresses_BD2(j, 3) - Nb_logs_BD1(i, 1)) < Ecart_en_cours Then
                Ecart_en_cours = Abs(Adresses_BD2(j, 3) - Nb_logs_BD1(i, 1))
                '''Resultat = Adresses_BD2(j, 2)
                Code_parcelle_BD1(i) = Adresses_BD2(j, 2) '''ajout
            End If
        End If
    Next j
   
    '''Worksheets("BD 1").Cells(i + 3, 53) = Resultat

Next i

Worksheets("BD 1").Range("BA4:BA" & Nb_adresses_a_trouver + 3) = Application.Transpose(Code_parcelle_BD1)  '''ajout

End Sub

FMDCC · 16 Avril 2018

Salut,

Merci pour cette nouvelle proposition.
En ce début de semaine, je suis sur d'autres dossiers. Je ne pourrai donc pas tester cela tout de suite mais je n'oublierai pas de faire un retour dès que ce sera le cas.

FMDCC · 19 Avril 2018

Salut,

J'ai enfin pu remettre le nez la dedans !
Je confirme que le traitements fonctionne très bien sur ma base de données complète.

Avec ton avant dernière proposition, sur un ensemble de 1224 adresses en BD1 et plusieurs communes en BD2 dont la plus petite comporte seulement 72 adresses et la grande comporte un peu plus de 10 000 adresses, le traitement a pris 5 minutes 37 sec.

Par contre, je n'ai pas pu faire fonctionner ta dernière solution car lorsque j'exécute , j'ai une erreur 9 : l'indice n'appartient pas à la sélection sur la ligne de code :

Code:

Code_parcelle_BD1(i) = "Pas de lien" 'ajout

FMDCC · 19 Avril 2018

J'ai trouvé, il fallait simplement ajouter cette ligne entre la première déclaration de ce tableau et cette ligne où on commence à le remplir :

Code:

ReDim Code_parcelle(Nb_adresses_a_trouver)

Et après essai, effectivement cette dernière solution est beaucoup plus efficace ! Toujours sur le même nombre de données (1224 adresses, etc.), le traitement n'a pris que 20 sec.

Impeccable

Je suis maintenant en train de regarder pour mettre en place une fenêtre d'information sur le traitement en cours avec % de progression, temps écoulé et estimation du temps restant. Pour ce dernier, je compte ajouter un tableau qui contiendra pour chaque adresse traitée le temps d'exécution. Puis tout les 1%, je calculerai la moyenne des durées présentent dans ce tableau que je multiplierai par le nombre d'adresses restant à traiter.

Qu'en penses-tu ?

Nairolf · 19 Avril 2018

Oui, ça peut être bien, mais cela ne restera qu'une estimation (un peu comme la copie de fichiers dans Windows) et c'est du temps de traitement supplémentaire.
Personnellement je ne mettrais que le pourcentage de progression et le temps écoulé.

FMDCC · 19 Avril 2018

Oui c'est sûr que ça demande davantage de traitements.

Finalement, je ne me suis pas embêté avec une modification à chaque changement de pourcentage et je réactualise la durée restante après chaque adresse traitée. De ce fait, plus le traitement progresse et plus l'estimation est fiable. Et après vérification, le traitement n'a pris qu'une seconde de plus.

Encore merci pour toute l'aide apportée.

FMDCC · 30 Avril 2018

Bonjour,

Finalement après réflexion, j'aimerai également pouvoir ramener dans la colonne BB en BD1 le nombre de logements associé à la parcelle trouvée (colonne BA) provenant donc de BD2.
Quelles sont les modifications à apporter ?

MàJ : j'ai modifié la ligne qui remplissait mes cellules en remplaçant Transpose par Resize.

XL 2013 Recherche filtrée avec un test et entre deux feuilles

FMDCC

XLDnaute Nouveau

Pièces jointes

Nairolf

XLDnaute Accro

FMDCC

XLDnaute Nouveau

FMDCC

XLDnaute Nouveau

Pièces jointes

Nairolf

XLDnaute Accro

FMDCC

XLDnaute Nouveau

FMDCC

XLDnaute Nouveau

FMDCC

XLDnaute Nouveau

Nairolf

XLDnaute Accro

FMDCC

XLDnaute Nouveau

FMDCC

XLDnaute Nouveau

Discussions similaires