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 :

Methode de rapatriement de données [XL-2013]


Sujet :

Macros et VBA Excel

  1. #1
    Futur Membre du Club
    Homme Profil pro
    Autre
    Inscrit en
    Mai 2014
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Autre

    Informations forums :
    Inscription : Mai 2014
    Messages : 13
    Points : 9
    Points
    9
    Par défaut Methode de rapatriement de données
    Bonjour à tous,

    Je viens solliciter votre aide pour un projet sur lequel je travaille. Sous VBA, je cherche à importer des données provenant d'un autre classeur ou d'une autre feuille en fonction d'un code unique.
    J'ai essayé plusieurs manières mais elle sont très longues.. (j'ai d'un côté, une base d'environ 30.000 lignes et 7 colonnes et de l'autre, 2000 codes pour lesquels je dois rechercher les informations dans la base et importer les données).

    J'ai tenté une boucle "for each"; la fonction recherche etc.. jusqu’à trouver sur Internet un petit code très bien qui fait appelle à la création d'un objet "dictionary". Celui ci fonctionne très bien mais en l'adaptant à mes besoins (càd, sur beaucoup de ligne) l'exécution prends énormément de temps..

    Voici le code que j'utilise :
    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
    Sub RechercheCodes()
     
     
    Set f = Worksheets("Resultat")
    nbligne = 2
     
    Do Until f.Cells(nbligne, 1) = ""
        moncode = f.Cells(nbligne, 1).Value
    On Error Resume Next
    Set mondico = CreateObject("scripting.dictionary")
       a = Worksheets("Base").[A2:D29902]
       For i = 1 To 29902
       mondico(a(i, 1)) = i
       Next i
       ligne = mondico(moncode)
       b = Application.Index(a, ligne)
     
    f.Cells(nbligne, 2).Value = b(2)
    f.Cells(nbligne, 3).Value = b(3)
    f.Cells(nbligne, 4).Value = b(4)
     
    nbligne = nbligne + 1
     
    Loop
     
    End Sub
    Il y a peut-être quelque chose que je fais mal.. L'idée globale est de scanner une liste de codes, puis rechercher ces codes dans un(e) autre page/classeur et rapatrier les colonnes B,C et D de la feuille "Base" vers la ligne du code recherché de la page "Résultat".

    En PJ un exemple sous excel qui contient le code VBA ci-dessus.

    Je suis preneur de tous les avis ou autre méthode plus performante.

    Merci à tous et très bon weekend
    Fichiers attachés Fichiers attachés

  2. #2
    Expert éminent

    Homme Profil pro
    Curieux
    Inscrit en
    Juillet 2012
    Messages
    5 073
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Curieux
    Secteur : Arts - Culture

    Informations forums :
    Inscription : Juillet 2012
    Messages : 5 073
    Points : 9 853
    Points
    9 853
    Billets dans le blog
    5
    Par défaut
    Bonjour,

    au vu de la disposition du fichier, un RECHERCHEV est idéal

    voici par VBA :

    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
    Sub RechercheCodes()
    Dim FEUILLE_RESULTAT As Worksheet
    Dim FEUILLE_SOURCE As Worksheet
        Set FEUILLE_RESULTAT = ThisWorkbook.Worksheets("Resultat")
        Set FEUILLE_SOURCE = ThisWorkbook.Worksheets("Base")
     
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
            With FEUILLE_RESULTAT.Cells(2, 2).Resize(FEUILLE_RESULTAT.UsedRange.Rows.Count - 1, 3)
                .FormulaR1C1 = "=VLOOKUP(RC1," & FEUILLE_SOURCE.Name & "!R1C1:R" & FEUILLE_SOURCE.UsedRange.Rows.Count & "C" & FEUILLE_SOURCE.UsedRange.Columns.Count & ",COLUMN(R1C),FALSE)"
                .Value = .Value
            End With
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
    End Sub
    pour avoir une source de données située dans une autre feuille ou un autre classeur, il suffit de modifier l'objet FEUILLE_SOURCE
    vu le nombre de lignes de ta base, j'ai opté pour un remplacement des formules par les valeurs

  3. #3
    Expert éminent sénior
    Avatar de Marc-L
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Avril 2013
    Messages
    9 468
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Avril 2013
    Messages : 9 468
    Points : 18 677
    Points
    18 677
    Par défaut


    Bonjour, bonjour !

    La ligne de code n°16 du post #1 est une catastrophe ‼
    Plus il y a de lignes dans la source de données plus ce code est long à l'exécution …
    Elle fait perdre le bénéfice de l'utilisation du dictionnaire et est inutile
    car les données sont déjà dans la variable tableau a donc pas besoin de la b !

    ______________________________________________________________________________________________________
    Je suis Paris, Charlie, …
    C'est parce que la vitesse de la lumière est plus rapide que celle du son que tant de gens paressent brillants avant d'avoir l'air con ! (Thomas Boishardy)

  4. #4
    Futur Membre du Club
    Homme Profil pro
    Autre
    Inscrit en
    Mai 2014
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Autre

    Informations forums :
    Inscription : Mai 2014
    Messages : 13
    Points : 9
    Points
    9
    Par défaut
    Merci beaucoup joe.levrai !! Enorme. Super rapide et top fiable le code ! Merci également d'avoir ajouter la bascule en valeur des formules, c'est exactement ce qu'il me fallait.

    Effectivement le coup de l'objet dictionary est pas mal mais sur des petit tableau (ou alors codé différemment). Je maitrise pas du tout cet objet.
    bon weekend à tous

    Ah si peut être une petite question quant à la ligne :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
     .FormulaR1C1 = "=VLOOKUP(RC1," & FEUILLE_SOURCE.Name & "!R1C1:R" & FEUILLE_SOURCE.UsedRange.Rows.Count & "C" & FEUILLE_SOURCE.UsedRange.Columns.Count & ",COLUMN(R1C),FALSE)"
    J'ai capté comment la modifier si je veux ajouter des colonne supplémentaire dans le Vlookup, mais je vois pas trop comment la modifier si je souhaite l'effectuer sur certaines colonnes de la "base" qui ne seront pas forcement continue

    Par exemple dans mon fichier base :
    Col A : Code unique
    Col B : Nom
    Col C : Numero série
    Col D : Prix
    Col E : Couleur

    et dans ma feuille "résultat" disont que pour la Col A (le code unique) je souhaite en :
    Col B : Numéro de Serie
    Col C : Couleur

    Est-il préférable que je duplique la ligne du Vlookup pour chaque colonne dès lors qu'elle ne suivent pas dans ma feuille Base ?

    Merci encore pour ton aide.

  5. #5
    Membre habitué Avatar de Klin89
    Profil pro
    Inscrit en
    Octobre 2008
    Messages
    119
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2008
    Messages : 119
    Points : 178
    Points
    178
    Par défaut
    Bonjour Fabfab750, Marc-L, joe.levrai, le forum

    Pour ton apprentissage
    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
    Option Explicit
     
    Sub test()
    Dim a, i As Long, j As Long, w
        a = Sheets("Base").Range("a1").CurrentRegion.Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            ReDim w(1 To UBound(a, 2))
            For i = 2 To UBound(a, 1)
                For j = 1 To UBound(a, 2)
                    w(j) = a(i, j)
                Next
                .Item(a(i, 1)) = w
            Next
            a = Sheets("resultat").Range("a1").CurrentRegion.Value
            For i = 2 To UBound(a, 1)
                If .Exists(a(i, 1)) Then
                    For j = 2 To UBound(a, 2)
                        a(i, j) = .Item(a(i, 1))(j)
                    Next
                End If
            Next
        End With
        'Restitution
        'Sheets("Resultat").Range("a1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
        'Pour l'exemple restitution dans une 3ème feuille
        Sheets(3).Range("a1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
    End Sub
    klin89

  6. #6
    Futur Membre du Club
    Homme Profil pro
    Autre
    Inscrit en
    Mai 2014
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Autre

    Informations forums :
    Inscription : Mai 2014
    Messages : 13
    Points : 9
    Points
    9
    Par défaut
    Hello Klin89

    La vache
    J'étais déjà pas à l'aise avec VBA mais la..
    Nan y'a une marge de progression c'est sûr mais..

    Bon le code tourne nickel, après je pipe pas une ligne. Je vais essayé de m'amuser avec pour voir si j'arrive à l'adapter à mes besoins (i.e. prendre certaine colonnes du fichier base mais pas toute, par ex, dans mon fichier base d'origine, la colonne ou je recherche le code se trouve en B et les données a rapatrier sont en G,H,I,K)

  7. #7
    Expert éminent

    Homme Profil pro
    Curieux
    Inscrit en
    Juillet 2012
    Messages
    5 073
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Curieux
    Secteur : Arts - Culture

    Informations forums :
    Inscription : Juillet 2012
    Messages : 5 073
    Points : 9 853
    Points
    9 853
    Billets dans le blog
    5
    Par défaut
    Bonjour,

    dans le second exemple que tu soumet, il semble y avoir une colonne d'écart pour le numéro de série (B et C) et deux colonnes d'écart pour la couleur (C et E)

    du coup, on peut jouer sur la portion de la formule qui utilise la colonne où est située la formule.
    mais il y aura des cas (de nombreux cas) où ces petits pirouettes ne fonctionneront pas :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
     .FormulaR1C1 = "=VLOOKUP(RC1," & FEUILLE_SOURCE.Name & "!R1C1:R" & FEUILLE_SOURCE.UsedRange.Rows.Count & "C" & FEUILLE_SOURCE.UsedRange.Columns.Count & ",2*COLUMN(R1C)-1,FALSE)"
    ou plus simplement, comme tu le suggères, traiter chaque colonne de destination séparément, ça prend un peu de lignes de codes en plus mais ça ralenti pas énormément le schmilblick

  8. #8
    Membre habitué Avatar de Klin89
    Profil pro
    Inscrit en
    Octobre 2008
    Messages
    119
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2008
    Messages : 119
    Points : 178
    Points
    178
    Par défaut
    Re Fabfab750,

    Pour revenir à ta remarque du post #6, tu peux définir la variable a comme ceci :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    With Sheets("Base").Range("A1").CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:" & _
                                    .Rows.Count & ")"), Array(2, 7, 8, 9, 11))
    End With
    à la place de :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    a = Sheets("Base").Range("a1").CurrentRegion.Value
    klin89

  9. #9
    Futur Membre du Club
    Homme Profil pro
    Autre
    Inscrit en
    Mai 2014
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Autre

    Informations forums :
    Inscription : Mai 2014
    Messages : 13
    Points : 9
    Points
    9
    Par défaut
    Bon et bien avec tout cela, me voila paré !
    Merci beaucoup à vous pour votre temps et vos explications. Ca va vraiment m'aider

    Encore merci à vous !

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

Discussions similaires

  1. Réponses: 2
    Dernier message: 08/07/2008, 11h47
  2. Rapatrier des données au même niveau
    Par Darcynette dans le forum SQL
    Réponses: 2
    Dernier message: 09/06/2008, 14h14
  3. [Debutant] Methodes de persistance des données ?
    Par Hesiode dans le forum Persistance des données
    Réponses: 3
    Dernier message: 22/01/2008, 09h48
  4. Rapatrier des données
    Par ANTMA dans le forum Macros et VBA Excel
    Réponses: 21
    Dernier message: 19/12/2007, 14h15
  5. Réponses: 2
    Dernier message: 20/11/2006, 21h42

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