IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

amélioration procédure vlookup ligne à ligne par lot [XL-2013]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2017
    Messages
    556
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Canada

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Santé

    Informations forums :
    Inscription : Janvier 2017
    Messages : 556
    Par défaut amélioration procédure vlookup ligne à ligne par lot
    Bonjour a vous cher(e)s ami(e)s du forum,


    J'ai un procédure fonctionnel mais très lente auquel je voudrais remplacer par quelques chose de plus rapide, si cela est possible.



    Voici donc la procédure en question

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    Sub copie_noproduit_ancienne_longue_et_mandat()
     
    Dim x As Long
    Dim cell As Variant
    Dim LettreVoulue As String
    LettreVoulue = TrouveLettreColonne([no_item_travail])
     
    On Error GoTo errohandler:
     
    Application.ScreenUpdating = False
     
    Sheets("Travail").Select
     
    For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
     
            x = x + 1
     
    'nettoyer les no d'item
     
        Sheets("Travail").Cells(x + 1, [no_item_travail].Column) = _
        StripAccent(UCase(CleanTrim(Sheets("Travail").Cells(x + 1, [no_item_travail].Column).value)))
     
     
    'recherche et copie de l'ancienne provinciale longue
     
        Sheets("Travail").Cells(x + 1, [ancienne_prov_longue].Column) = Application.VLookup(Sheets("Travail").Cells _
        (x + 1, [no_item_travail].Column), _
        Worksheets("catalogue").Range("A1").CurrentRegion, 3, False)
     
     
    'recherche et copie du no produit
     
        Sheets("Travail").Cells(x + 1, [no_produit_travail].Column) = Application.VLookup(Sheets("Travail").Cells _
        (x + 1, [no_item_travail].Column), _
        Worksheets("catalogue").Range("A1").CurrentRegion, 2, False)
     
     
    'recherche et copie mandat
     
        Sheets("Travail").Cells(x + 1, [mandat_lac].Column) = rmult(Sheets("Travail").Cells _
        (x + 1, [no_item_travail].Column), _
        Worksheets("mandat").Range("A1").CurrentRegion, 2)
     
     
        Next cell
     
    Application.ScreenUpdating = True
     
    Exit Sub
     
    errohandler:
     
    Application.ScreenUpdating = True
    MsgBox "erreur sur la ligne " & x + 1, vbCritical
     
    End Sub
    DOnt celle-ci contient les procédures et/ou fontions suivantes :


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
     
    Public Function TrouveLettreColonne(ByVal ColonneCherche As Range) As String
     
    TrouveLettreColonne = Split(Columns(ColonneCherche.Column).Address(ColumnAbsolute:=False), ":")(1)
     
    End Function
     
    Public Function LastLignUsedInColumn(NomColumn As String)
     
    LastLignUsedInColumn = Range(NomColumn & Rows.Count).End(xlUp).Row
     
    End Function
     
    Function CleanTrim(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
     
        Dim x As Long, CodesToClean As Variant
     
        CodesToClean = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
                             21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 127, 129, 141, 143, 144, 157)
     
        If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
     
        For x = LBound(CodesToClean) To UBound(CodesToClean)
     
        If InStr(S, Chr(CodesToClean(x))) Then S = Replace(S, Chr(CodesToClean(x)), "")
     
        Next
     
        CleanTrim = WorksheetFunction.Trim(S)
     
    End Function
     
    Function rmult(valeurachercher As Variant, plageachercher As Range, numcolonne As Long) As Variant
        Dim u As Variant
        Dim nb As Long
        Dim boucle As Long
     
        For boucle = 1 To plageachercher.Rows.Count
     
            If plageachercher(boucle, 1) = valeurachercher Then
                u = u & plageachercher(boucle, numcolonne) & Chr(10)
                nb = nb + 1
            End If
     
        Next boucle
     
        If Right$(u, 1) = Chr(10) Then u = Left$(u, Len(u) - 1)
     
        rmult = u
     
    End Function
    Cette procédure permet de populer un fichier de travail. Elle fait 2 vlookup afin de populer de l'information pertinente ainsi que la fonction rmult qui est comme un vlookup mais renvoi toute les données possibles contrairement a vlookup qui renvoi seulement le premier trouvé. C'Est à mon avis cette dernière fonction qui ralenti un peu mon processus.


    Donc j'ai deux questions sois pouvont nous effectuer cette popuilation de mon fichier en lot ou block au lieu de passé ligne par ligne ??? Si cette dernière n'Est pas possible avez vous une solution afin de rendre plus rapide la fonction rmult ???




    merci d'avance pour le temps consacrer a m'aider, c'est plus qu'apprécié !!!

    amicalement JP

  2. #2
    Modérateur

    Homme Profil pro
    Inscrit en
    Octobre 2005
    Messages
    15 410
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Canada

    Informations forums :
    Inscription : Octobre 2005
    Messages : 15 410
    Par défaut
    Bonjour.

    Il est très possible que LastLignUsedInColumn(LettreVoulue) soit exécuté pour chacune des lignes donc si il ne change pas je te suggère :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    dim derniereLigne as long: dernierLigne=LastLignUsedInColumn(LettreVoulue)
    ...
    For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & lastLine)
    Comme toutes tes données copiées semblent sur la même ligne dans la feuille source, tu pourrais utiliser WorksheetFunction.Match(TaValeur, TaColonneDeRecherhe, 0) pour récupérer le numéro de la ligne dans la source.
    Après tu peux simplement copier les données directement de cette ligne plutôt que de faire une recherche à chaque fois.

    Si tu n'as pas de sélection par filtre dans ta feuille source, tu pourrais aussi utiliser TaFeuilleSource.TaColonneDeDonnees.Find() qui te retourne la cellule contenant la donnée. Aprèes tu n'as plus qu'à prendre l'offset de cette cellule pour récupérer les données adjacentes.

    Enfin tu pourrais peut-être neutraliser les calculs jusqu'à la fin de la procédure.

    Au début tu mets Application.Calculation=xlCalculationManual.
    et à la fin tu mets Application.Calculation=xlCalculationAutomatic.

    Comme cela au lieu de faire tes calculs à chaque modification de la valeur d'une cellule, tu ne les fait qu'une seule fois après toutes les modifs.

    A+
    Vous voulez une réponse rapide et efficace à vos questions téchniques ?
    Ne les posez pas en message privé mais dans le forum, vous bénéficiez ainsi de la compétence et de la disponibilité de tous les contributeurs.
    Et aussi regardez dans la FAQ Access et les Tutoriaux Access. C'est plein de bonnes choses.

  3. #3
    Membre éclairé
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2017
    Messages
    556
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Canada

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Santé

    Informations forums :
    Inscription : Janvier 2017
    Messages : 556
    Par défaut
    Un gros merci marot_R


    c'est vraiment apprécié !!!


    J'ai testé en mettant LastLignUsedInColumn(LettreVoulue) comme variable et résultat approximatif meme legerement suppérieur d'une seconde à la procédure de départ

    MOn calcul était déjà en mode manuel, donc en mettant également Application.Calculation=xlCalculationManual n'a pas changer dans ma situation mais cela aurais pu etre effectivement un ralentissement pénible


    Il me reste les 2 autres possibilités que vous m'avez identifiés a testé, cependant a titre indicatif ma donnée cherché est dans la feuille Travail colonne C. Mes données auquel je trouve l'information sont dans la colonne C et E, donc non contigüe.

    Si je comprends bien, je ne peut utiliser l'option de la copie de ligne complete étant donné ce fais ?


    L'option TaFeuilleSource.TaColonneDeDonnees.Find() semble celle qui selon moi pourrais me gagner du temps.


    Je vais donc la tester et vous revenir si j'ai un gain en vitesse.


    merci encore une fois pour votre coup de pouce !!!!!

  4. #4
    Membre Expert
    Homme Profil pro
    PAO
    Inscrit en
    Octobre 2014
    Messages
    2 576
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : PAO
    Secteur : Communication - Médias

    Informations forums :
    Inscription : Octobre 2014
    Messages : 2 576
    Par défaut
    Bonjour ,

    Tu peux toujours utiliser une feuille tampon avec un filtre élaboré qui te permettra d'afficher toutes les lignes trouvées et seulement les colonnes C et E
    on l'avait déjà vu

    => les explications si besoin : Les filtres avancés ou élaborés dans Excel

    et là c'est très rapide
    Cordialement
    Ryu

    La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein

    Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple

    Une fois votre problème solutionné pensez à mettre :resolu: en n'oubliant pas d'indiquer qu'elle est la solution finale choisie ;)

  5. #5
    Membre éclairé
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2017
    Messages
    556
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Canada

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Santé

    Informations forums :
    Inscription : Janvier 2017
    Messages : 556
    Par défaut
    Super Ryu,


    Je vais essayer les filtres élaborés après avoir terminé la solution de marot_r que je n'ai pas encore eu le temps de tester.



    Si le filtre élaboré pourrais également remplacer la fonction rmult, là j'aurais le top du top en terme de vitesse


    Je vous reviens donc après mes tests !!!


    merci encore les amis

  6. #6
    Membre éclairé
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2017
    Messages
    556
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Canada

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Santé

    Informations forums :
    Inscription : Janvier 2017
    Messages : 556
    Par défaut
    Bonjour a vous,


    J'ai finalement décidé d'essayé en premier la solution de Ryu et je n'ai malheureusement aucun gain de vitesse . , j'ai environ le meme résultat

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    Sub test_copie_Filtre()
     
    Dim x As Long
    Dim cell As Variant
    Dim LettreVoulue As String
    LettreVoulue = TrouveLettreColonne([no_item_travail])
     
     
    Dim start As Single
    Dim finish As Single
     
     
    start = Timer
     
     
     
    On Error GoTo errohandler:
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     
    If sheetExists("filtre") Then Sheets("filtre").Delete
     
     
    '_______________________________________________________
     
    Sheets.Add.Name = "filtre"
     
    Sheets("filtre").Range("a1") = Sheets("catalogue").Range("a1")
    Sheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInSheet_Column("Travail", LettreVoulue)).Copy Sheets("filtre").Range("a2")
     
     
    Sheets("filtre").Range("d1") = Sheets("catalogue").Range("b1")
    Sheets("filtre").Range("e1") = Sheets("catalogue").Range("c1")
     
     
     
    'on nomme la plage filtration afin de facilité le code
     
        Sheets("filtre").Range("a2").CurrentRegion.Name = "item_filtre"
     
    'on nomme la plage de destination afin de facilité le code
     
        Sheets("filtre").Range("d2").CurrentRegion.Name = "destination"
     
    'on nomme la plage de départ afin de facilité le code
     
        Sheets("catalogue").Range("d2").CurrentRegion.Name = "depart"
     
     
    Sheets("catalogue").[depart].AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=[item_filtre], CopyToRange:=[Destination], _
            Unique:=True
     
     
    Sheets("filtre").Range("d2:d" & LastLignUsedInSheet("filtre")).Copy _
    Sheets("Travail").Range(TrouveLettreColonne([no_produit_travail]) & 2)
     
     
    Sheets("filtre").Range("e2:e" & LastLignUsedInSheet("filtre")).Copy _
    Sheets("Travail").Range(TrouveLettreColonne([ancienne_prov_longue]) & 2)
     
    Sheets("filtre").Delete
     
    '_______________________________________________________
     
     
    Sheets("Travail").Select
     
    For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
     
            x = x + 1
     
    'nettoyer les no d'item
     
        Sheets("Travail").Cells(x + 1, [no_item_travail].Column) = _
        StripAccent(UCase(CleanTrim(Sheets("Travail").Cells(x + 1, [no_item_travail].Column).value)))
     
     
     
     
    'recherche et copie mandat
     
        Sheets("Travail").Cells(x + 1, [mandat_lac].Column) = rmult(Sheets("Travail").Cells _
        (x + 1, [no_item_travail].Column), _
        Worksheets("mandat").Range("A1").CurrentRegion, 2)
     
     
        Next cell
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
    finish = Timer
    MsgBox "durée du traitement: " & finish - start & " secondes"
     
     
    Exit Sub
     
    errohandler:
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "erreur sur la ligne " & x + 1, vbCritical
     
    End Sub

    Il me reste la dernière option de marot_r, sinon c'est mon code de départ ...

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2013] amélioration procédure ligne a ligne par procédure optimiser
    Par jpvba dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 30/08/2019, 15h52
  2. Traitements en ligne par lots
    Par Intra-sites dans le forum Imagerie
    Réponses: 0
    Dernier message: 23/05/2018, 09h40
  3. [MCD] Ligne d'achat par lot ou unité simple?
    Par alassanediakite dans le forum Schéma
    Réponses: 7
    Dernier message: 09/05/2012, 18h56
  4. Numérotation de lignes par lots
    Par delph_le dans le forum SAS Base
    Réponses: 3
    Dernier message: 28/07/2009, 10h34
  5. Renvois Identifiant ligne par procédure stockée
    Par MAXIPAT dans le forum MS SQL Server
    Réponses: 1
    Dernier message: 08/02/2007, 09h21

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo