Importation d'informations Résolu

Question

Bonjour, 

Je vous explique ma situation.
J'ai un document A et un document B.
Qui sont pour la forme identique.
Donc le ficher A est un ficher récent et le B plus anciens. J'ai besoin de compléter mon fichier A par le B. Dans ma colonne A j'ai mes ITM (référence produit).
Je veux que chaque cellule, de mon fichier A, de ma colonne A soit recherché dans mon fichier B ( dans la colonne A aussi) et si il y a correspondance copier les cellule de cette ligne en (K,L,M,N,O) et les colles dans mon ficher A. Donc j'aurai un fichier complet. 

Voila mon début de code:
Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de colonnes)

Set CD = ThisWorkbook 'définit la classeur destination CD
With Application.FileDialog(msoFileDialogOpen) 'prend en compte la boîte de dialogue permettant l'ouverture d'un fichier
    .Show 'ouverture
    On Error GoTo fin 'en cas d'erreur, va à l'étiquette "fin"
    Workbooks.Open (.SelectedItems(1)) 'ouvre le premier fichier sélectionné et ferme la boîte de dialogue (génère une erreur si bouton [Annuler])
End With 'fin de la prise en compte de la boîte de dialogue permettant l'ouverture d'un fichier
Set CS = ActiveWorkbook 
TV = Range("A1").CurrentRegion 
NL = UBound(TV, 1)
NC = UBound(TV, 2)

End Sub


MERci



Configuration: Windows 7 / Chrome 51.0.2704.103

f894009 · Answer

Bonjour,

quelques modifs de votre code et des lignes en plus


Sub Macro1()
    Dim Dico_Data As Object, PlageA, PlageB, derlig1, x, Fin
    
    'Application.ScreenUpdating = False
    'fichier A
    Set Dico_Data = CreateObject("Scripting.Dictionary")
    With Worksheets("feuil1")
        derlig1 = .Range("A" & Rows.Count).End(xlUp).Row   'derniere cellule non vide colonne A
        PlageA = .Range("A2:A" & derlig1)                               'mise en memoire
    End With
    'boucle sur plage
    Fin = UBound(PlageA, 1)      'longueur table
    For x = 1 To Fin
        Dico_Data(PlageA(x, 1)) = x + 1   'mise en memoire ref et ligne ref dans dictionnaire---->x+1 pour ligne 2
    Next x
    'ouverture et recup fichier B
    Application.FileDialog(msoFileDialogOpen).Filters.Add "Excel files (*.xlsx)", "*.xlsx", 1 'prend en compte la boîte de dialogue permettant l'ouverture d'un fichier
    If Not (Application.FileDialog(msoFileDialogOpen).Show) Then
        MsgBox "Pas de fichier selectionne !!!!!.", vbExclamation, "PAS BIEN !!!!!!!!"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    With Application.FileDialog(msoFileDialogOpen)
        Workbooks.Open (.SelectedItems(1)) 'ouvre le premier fichier sélectionné et ferme la boîte de dialogue (génère une erreur si bouton [Annuler])
        nom_Fichier = Right(.SelectedItems(1), Len(.SelectedItems(1)) - InStrRev(.SelectedItems(1), "\"))   'nom de fichier avec extention
    End With
    With Workbooks(nom_Fichier).Worksheets("feuil1")
        derlig1 = .Range("A" & Rows.Count).End(xlUp).Row   'derniere cellule non vide colonne A
        PlageB = .Range("A2:O" & derlig1)                               'mise en memoire plage de cellules fichier B
    End With
    Fin = UBound(PlageB)    'nombre de "ligne"
    Workbooks(nom_Fichier).Close False
    'retour fichier A
    With Worksheets("feuil1")
        For x = 1 To Fin
            If Dico_Data.exists(PlageB(x, 1)) Then      'ref existe en A et B
                Lg = Dico_Data(PlageB(x, 1))                'ligne ref fichier A
                .Range("K" & Lg) = PlageB(x, 11)          'ecriture des infos
                .Range("L" & Lg) = PlageB(x, 12)
                .Range("M" & Lg) = PlageB(x, 13)
                .Range("N" & Lg) = PlageB(x, 14)
                .Range("O" & Lg) = PlageB(x, 15)
            End If
        Next x
    End With
    Application.ScreenUpdating = True
End Sub

Importation d'informations

1 réponse

Discussions similaires

Newsletters