Automatiser la recherchev par une Macro

Bonjour,

Je m'adresse au forum afin d'avoir de l'aide sur une réalisation que je souhaiterais faire.

J'ai un extrait de fichier comptable, et je souhaiterai automatisé la recherche v par une macro qui me permettra de minimisé le temps.

J'ai 2 onglets sur un fichier. Une liste de référence avec type de CDT et une liste de référence sans type de CDT.

Les 2 listes ont un point commun qui est la colonne "Référence" dans mon exemple. Je souhaite faire une recherche v dans l’anglet « Les_cdt » en affichant les informations qui se trouve dans l’onglet « Type », a savoir que le fichier contient 300 000 lignes

Je vous joins un extrait du fichier ça peut être plus parlant que mes explications.

Merci pour votre aide

27base-global.xlsx (14.53 Ko)

Bonjour,

Avec un tableau (array), en une seule passe, par dichotomie ...

Sub rechercher()
Dim d
d = Sheets("Type").ListObjects(1).DataBodyRange.Value
For i = 3 To Range("I" & Rows.Count).End(xlUp).Row
    ligne = dichotomie(Range("I" & i), d)
    If ligne <> 0 Then
        Range("Q" & i) = d(ligne, 1)
        Range("R" & i) = d(ligne, 2)
        Range("S" & i) = d(ligne, 3)
    Else
        Range("Q" & i) = "#NA"
        Range("R" & i) = "#NA"
        Range("S" & i) = "#NA"
    End If
Next
End Sub

Function dichotomie(valeurcherchee As Variant, tableau) As Double
' donne la ligne de la valeur recherchée (0 si pas trouvé)
Dim deb As Double, fin As Double, milieu As Double
Dim valeurcourante As Variant

    dichotomie = 0
    deb = LBound(tableau)
    fin = UBound(tableau)
    If valeurcherchee = tableau(deb, 1) Then dichotomie = deb: Exit Function
    If valeurcherchee = tableau(fin, 1) Then dichotomie = fin: Exit Function

    While deb <> fin - 1
        milieu = Int((deb + fin) / 2)
        valeurcourante = tableau(milieu, 1)
        If valeurcourante = valeurcherchee Then
            dichotomie = milieu
            Exit Function
        Else
            If valeurcourante > valeurcherchee Then
                fin = milieu
            Else
                deb = milieu
            End If
        End If
    Wend

End Function
24base-global.xlsm (23.83 Ko)

On peut encore accélérer en passant par un tableau de résultats au lieu d'écrire ligne à ligne ... ce que je vais faire ce soir.

Tu me donneras le temps de réponse approximatif sur 300.000 lignes.

Hello Steelson

Je te remercie

Oui cava m'aider plus si tu le ferai développe par tableau de résultat

concernant la première ligne j'ai ajoute la ligne pour faire la recherche V c'est un travail en plus

donc c'est possible de supprimer la premier ligne dans l'onglet "Les_cdt" et de faire le même travail

Merci d'avance

Version plus rapide ... (j'ai supprimé la première ligne)

Sub rechercher()
Dim data, resultat, valeurs
    Top = Now
    data = Sheets("Type").ListObjects(1).DataBodyRange.Value
    valeurs = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))
    ReDim resultats(1 To UBound(valeurs), 1 To 3)
    For i = 1 To UBound(valeurs)
        ligne = dichotomie(valeurs(i, 1), data)
        If ligne <> 0 Then
            resultats(i, 1) = data(ligne, 1)
            resultats(i, 2) = data(ligne, 2)
            resultats(i, 3) = data(ligne, 3)
        Else
            resultats(i, 1) = "#NA"
            resultats(i, 2) = "#NA"
            resultats(i, 3) = "#NA"
        End If
    Next
    Range("Q2").Resize(UBound(resultats), UBound(resultats, 2)) = resultats
    MsgBox "Actualisé en " & Format(Now - Top, "hh:mm:ss")
End Sub

Function dichotomie(valeurcherchee As Variant, tableau) As Double
' donne la ligne de la valeur recherchée (0 si pas trouvé)
Dim deb As Double, fin As Double, milieu As Double
Dim valeurcourante As Variant

    dichotomie = 0
    deb = LBound(tableau)
    fin = UBound(tableau)
    If valeurcherchee = tableau(deb, 1) Then dichotomie = deb: Exit Function
    If valeurcherchee = tableau(fin, 1) Then dichotomie = fin: Exit Function

    While deb <> fin - 1
        milieu = Int((deb + fin) / 2)
        valeurcourante = tableau(milieu, 1)
        If valeurcourante = valeurcherchee Then
            dichotomie = milieu
            Exit Function
        Else
            If valeurcourante > valeurcherchee Then
                fin = milieu
            Else
                deb = milieu
            End If
        End If
    Wend

End Function
16base-global-v2.xlsm (24.95 Ko)

Bonjour

Oui sa serais exactement cela. Je te remercié chef Excel

dès que je termine de mon projet je te ferai un retour, merci encore une fois

A bientôt

Je reviens sur le sujet, il existe une solution sans macro bien plus rapide que la version RECHERCHEV(___FAUX), au moins 10 fois !

Il faut

  • faire un EQUIV avec le dernier paramètre égal à 1 pour rechercher la ligne de la valeur la plus proche, il faut que la table soit triée
  • comparer cette valeur à la valeur recherchée
  • et si ok, faire un index pour les autres colonnes
4base-global.xlsx (14.16 Ko)

Bonjour,

Désolé d'avoir répondu en retard

Je te remercie pour les deux solutions que tu m’as fournis ça ma aider bcp

Bon journée chef

Bonjour,

Désolé de te répondre en retard

Je te remercie pour les deux solutions que tu m’as fournis ça ma aider bcp

Sauf que je n'arrive pas à attacher la macro que tu m’as écrite au milieu d’une macro principale « multi fonction »

Je veux dire que j’ai un projet pour automatiser les taches par une macro qui se présente comme suit :

1/ Importé les données externe

2/ Faire la rechecheV

3/ Faire un TCD pour un contrôle

4/ Présentation des constats

Serait-il possible de m’orienter afin d’attacher la Macro rechecheV avec les deux autre macro, Je veux dire comment faire pour lier les trois macro reprises dans le fichier en PJ

Merci d’avance

C'est bien d'enregistrer des macros, mais ensuite il faut y mettre les mains ... j'ai relevé au moins 2 difficultés :

que fait-on si le nombr de lignes n'est pas 10 ?

"Les_cdt!R1C1:R10C19"

il faudrait d'abord supprimer la feuille TCD si elle avait déjà été créée

Sheets("Feuil2").Name = "TCD"

Comme je ne connais pas Projet_automatisation je ne peux pas te répondre.

Bonjour Steelson,

Je suis débutant en VBA c’est pour ça que j’ai utilisé l'enregistreur de macro… dans l’attente de faire une formation complète sur le VBA.

Je t’explique mon projet

1/ La macro nommé ‘Projet_automatisation’ elle consiste à importer des données externe pour alimenter ma base de donnée, ces dernières sont enregistrées dans les deux onglets nommé comme suite « Type » et « Les_cdt ».

2/ A partir de ces données j’ai fait une macro (rechechev ) pour compléter le fichier « Les_cdt » par des données qui se trouvent dans le classeur nommé « Type ».

3/ Après avoir complété le fichier, je fais un TCD pour le fichier « Les_cdt » afin que je puisse faire un contrôle

Mon besoin est d’attacher les deux étapes 2 et 3 à la macro ‘Projet_automatisation’ afin d'avoir une seule Macro

Mon objectif est d’automatiser tout ce travail par un seul bouton

Concernant le nombre de lignes j’utilise ça : Range(Selection, Selection.End(xlDown)).Select

Range(Selection, Selection.End(xlToRight)).Select

Stp Mr, tu peux m’aider afin de réaliser cette macro

Merci d'avance

Comme je ne connais pas Projet_automatisation je ne peux pas te répondre.

désolé !

J'ai répondu à ta demande initiale, mais pour celle-ci il faudrait les données source et comprendre ta méthode d'extraction des données que je ne connais pas.

Si tu veux une réponse, ferme ce post et ouvre-s-en un autre pour appeler d'autres contributeurs.

Bonjour,

Ok je vais faire une nouvelle demande

Merci Bcp

Rechercher des sujets similaires à "automatiser recherchev macro"