Methode de rapatriement de données

Version imprimable

1 pièce(s) jointe(s)

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:

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 :P

Bonjour,

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

voici par VBA :

Code:

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

06/02/2016, 16h08
Marc-L

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, …
06/02/2016, 17h33
Fabfab750

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:

.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.

Bonjour Fabfab750, Marc-L, joe.levrai, le forum :)

Pour ton apprentissage :ptdr:

Code:

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

06/02/2016, 17h55
Fabfab750

Hello Klin89

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

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)
06/02/2016, 18h18
joe.levrai

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:

.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
06/02/2016, 19h08
Klin89
Re Fabfab750,

Pour revenir à ta remarque du post #6, tu peux définir la variable a comme ceci :
Code:

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:

a = Sheets("Base").Range("a1").CurrentRegion.Value

klin89
07/02/2016, 15h58
Fabfab750

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 !