Mise à jour d'un fichier à partir d'un autre

Bonjour à tous,

Je viens jsute de découvrir le forum et quel source d'information! Il y a de quoi se perdre et c'est mon cas...

Alors voilà, je dois mettre à jour un fichier (Fichier_à_mettre_à_jour.xlsx, organiser sous forme d'un tableau) à partir d'un autre fichier (Fichier_source.xlsx, lui aussi organisé sous forme de tableau). Les noms des collones ne sont pas les même dans les deux fichiers, mais j'ai fais la relation entre les deux (Relation.xlsx).

Chaques lignes a un code unique qui se retrouve dans les deux fichiers. Vous l'avez sans doute compris, c'est un fait un extrait d'une base de donné mais comme je ne peux pas accéder directement à celle-ci, je suis obligé de traiter ceci de cette façon.

Il y a aussi une collone qui doit être remplie avec un 1 si la ligne doit être ajoutée ou si elle est mise à jour, et avec un 3 si elle va devoir être retirée

Je suis en train de regarder comment fonctionne VBA et je commence doucement à m'en sortir mais ce n'est pas si facile.

J'espère que vous pourrez m'aider

Bonjour,

Je reviens vers vous pour vous faire un point d'où j'en suis.

J'ai cherché à trier les tableaux en fonction de l'ID de chacun. Cela fonctionne bien sauf pour Fichier_source où le tris se fais uniquement sur une partie du tableau (jusque la colonne H ou I). Dans ce même fichier, j'ai du déplacer la colonne des ID au début sinon ça ne marchais pas...

voilà voilà

edit : le tri ne fonctionne pas car la sélection ne se fais pas sur tout le tableau, comme il y a une colonne vide

Et voici le code que j'utilise :

Sub tri_Fichier()
 Dim MyDataFirstCell
 Dim MyDataLastCell
 Dim MySortCellStart
 Dim MySortCellEnd

 Windows("Fichier_à_mettre_à_jour.xlsx").Activate ' Go to my data file

 '************************** Establish the Data Area
 Range("A1").Select 'Get to the first cell of data area
 MyDataFirstCell = ActiveCell.Address 'Get the first cell address of Data Area
 Selection.End(xlDown).Select 'Get to Bottom Row of the data
 Selection.End(xlToRight).Select 'Get to the last Column and data cell by heading to the righthand end
 MyDataLastCell = ActiveCell.Address 'Get the Cell address of the last cell of my data area

 '************************** Establish the Sort column first and last data points.
 Range("F2").Select 'Get to first cell of data sort Column (Example Col 'F' Row 2 becuase Row 1 contains the header)
 MySortCellStart = ActiveCell.Address 'Get the Cell address of the first cell of my data sort Column
 Selection.End(xlDown).Select 'Get to the bottom Row of data
 MySortCellEnd = ActiveCell.Address 'Get the Cell address of the last cell of my sort Column

 '************************** Start the sort by specifying sort area and columns
 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add _
 Key:=Range(MySortCellStart & ":" & MySortCellEnd), SortOn:=xlSortOnValues, Order:=xlDescending, _
 DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets("Sheet1").Sort
 .SetRange Range(MyDataFirstCell & ":" & MyDataLastCell)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With

 Windows("Fichier_source.xlsx").Activate ' Go to my data file

 '************************** Establish the Data Area
 Range("A1").Select 'Get to the first cell of data area
 MyDataFirstCell = ActiveCell.Address 'Get the first cell address of Data Area
 Selection.End(xlDown).Select 'Get to Bottom Row of the data
 Selection.End(xlToRight).Select 'Get to the last Column and data cell by heading to the righthand end
 MyDataLastCell = ActiveCell.Address 'Get the Cell address of the last cell of my data area

 '************************** Establish the Sort column first and last data points.
 Range("A2").Select 'I move the ID to columns A beacause it don't work when the ID is in columns O
 MySortCellStart = ActiveCell.Address 'Get the Cell address of the first cell of my data sort Column
 Selection.End(xlDown).Select 'Get to the bottom Row of data
 MySortCellEnd = ActiveCell.Address 'Get the Cell address of the last cell of my sort Column

 '************************** Start the sort by specifying sort area and columns
 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add _
 Key:=Range(MySortCellStart & ":" & MySortCellEnd), SortOn:=xlSortOnValues, Order:=xlDescending, _
 DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets("Sheet1").Sort
 .SetRange Range(MyDataFirstCell & ":" & MyDataLastCell)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With

 End Sub

bonjour,

une proposition de macro, que je mets dans relation (d'où le le changement de nom relation.xlsm au lieu de relation.xlsx

les 3 fichiers doivent être ouverts avant exécutio de la macro.

Dim wsr, wsbase, wsmodif, dlr, dlbase, dlmodif
Sub miseajour()

    Set wsr = Workbooks("relation.xlsm").Worksheets("sheet1") ' wsr feuille relation
    Set wsbase = Workbooks("fichier_à_mettre_à_jour.xlsx").Worksheets("Plan1") ' wsbase feuille maitre
    Set wsmodif = Workbooks("fichier_source.xlsx").Worksheets("Plan1") ' wsmodif feuille avec les modifications
    dlr = wsr.Range("A" & Rows.Count).End(xlUp).Row ' dlr dernière ligne relation
    uidbase = wsr.Range("B1:B" & dlr).Find("STORE_ID").Offset(0, -1).Value ' uidbase colonne de wsbase contenant l'identifiant unique
    dlbase = wsbase.Range(uidbase & Rows.Count).End(xlUp).Row ' dlbase dernière ligne de wsbase
    actionbase = wsr.Range("B1:B" & dlr).Find("UPDATE_ACTION").Offset(0, -1).Value 'actionbase colonne de wsbase contenant l'action
    wsbase.Range(actionbase & "2") = 3 ' par defaut toutes les lignes sont à supprimer
    wsbase.Range(actionbase & "2").Copy
    wsbase.Activate
    wsbase.Range(actionbase & "3:" & actionbase & dlbase).Select
    wsbase.Paste
    uidmodif = wsr.Range("C1:C" & dlr).Find("StoreNRID").Offset(0, 1).Value ' uidmoif colonne de wsmodif contenant l'identifiant unique
    dlmodif = wsmodif.Range(uidmodif & Rows.Count).End(xlUp).Row ' dlmodif dernière ligne de wsmodif
    For i = 2 To dlmodif ' on parcourt toutes les lignes de wsmodif
        Set re = wsbase.Range(uidbase & "2:" & uidbase & dlbase).Find(wsmodif.Range(uidmodif & i)) ' on recherche l'identifiant unique de wsmodif dans wsbase
        If re Is Nothing Then 'si on ne le trouve pas on ajoute une ligne dans base
            dlbase = dlbase + 1
            wsbase.Rows(dlbase).Insert shift:=xlDown
            wsbase.Range(actionbase & dlbase) = copydata(i, dlbase)
        Else ' sinon on copie les données modifiées
            wsbase.Range(actionbase & re.Row) = copydata(i, re.Row)
        End If
    Next i
    Set re = Nothing
    Set wsr = Nothing
    Set wsbase = Nothing
    Set wsmodif = Nothing
End Sub

Function copydata(a, b)
'copie les données de la wsmodif ligne a vers wsbase ligne b en fonction du tableau de relation
    r = Empty
    For i = 2 To dlr ' on parcourt toutes les colonnes à copier
        If wsr.Range("D" & i) <> "" Then
            cols = wsr.Range("D" & i) ' cols identifiant de la colonne source à copier
            colt = wsr.Range("A" & i) ' colt identifiant de la colonne cible
            If wsbase.Range(colt & b) <> wsmodif.Range(cols & a) Then wsbase.Range(colt & b) = wsmodif.Range(cols & a): r = 1 ' on copie si différent entre source et cible
        End If
    Next i
    copydata = r
End Function

Et ben... Je sais pas quoi dire si ce n'est un grand merci!!!

Le script marche comme sur des roulettes, il faut juste faire attention à ce que les feuilles soient bien nomée sinon ça marche pas.

Par contre est-il possible que si la ligne n'est pas modifiée de laisser le champs updates vide?

skip1 a écrit :

Et ben... Je sais pas quoi dire si ce n'est un grand merci!!!

Le script marche comme sur des roulettes, il faut juste faire attention à ce que les feuilles soient bien nomée sinon ça marche pas.

Par contre est-il possible que si la ligne n'est pas modifiée de laisser le champs updates vide?

c'est normalement bien le cas, (tu peux le vérifier en relançant la macro sur les mêmes fichiers).

r( qui sert à alimenter le champ update) est remis à blanc lors du traitement de chque ligne modif.

l'instruction ci-dessous met r à 1 dès qu'il y a un changement sur la ligne

If wsbase.Range(colt & b) <> wsmodif.Range(cols & a) Then wsbase.Range(colt & b) = wsmodif.Range(cols & a): r = 1 ' on copie si différent entre source et cible

Effectivement c'est bien le cas

Encore une denière petite question, je ne parviens pas à bien saisir où se fait la comparaison entre les deux fichiers. Dans le script, où se fait la liaison entre les deux fichiers?

re-bonjour,

le lien entre les 2 fichiers est recherché (s'il existe) dans la partie surlignée (on prend uid de modif et on le recherche dans base

la copie de données modifiées se fait dans copydata.

Dim wsr, wsbase, wsmodif, dlr, dlbase, dlmodif
Sub miseajour()

    Set wsr = Workbooks("relation.xlsm").Worksheets("sheet1") ' wsr feuille relation
   Set wsbase = Workbooks("fichier_à_mettre_à_jour.xlsx").Worksheets("Plan1") ' wsbase feuille maitre
   Set wsmodif = Workbooks("fichier_source.xlsx").Worksheets("Plan1") ' wsmodif feuille avec les modifications
   dlr = wsr.Range("A" & Rows.Count).End(xlUp).Row ' dlr dernière ligne relation
   uidbase = wsr.Range("B1:B" & dlr).Find("STORE_ID").Offset(0, -1).Value ' uidbase colonne de wsbase contenant l'identifiant unique
   dlbase = wsbase.Range(uidbase & Rows.Count).End(xlUp).Row ' dlbase dernière ligne de wsbase
   actionbase = wsr.Range("B1:B" & dlr).Find("UPDATE_ACTION").Offset(0, -1).Value 'actionbase colonne de wsbase contenant l'action
   wsbase.Range(actionbase & "2") = 3 ' par defaut toutes les lignes sont à supprimer
   wsbase.Range(actionbase & "2").Copy
    wsbase.Activate
    wsbase.Range(actionbase & "3:" & actionbase & dlbase).Select
    wsbase.Paste
    uidmodif = wsr.Range("C1:C" & dlr).Find("StoreNRID").Offset(0, 1).Value ' uidmoif colonne de wsmodif contenant l'identifiant unique
   dlmodif = wsmodif.Range(uidmodif & Rows.Count).End(xlUp).Row ' dlmodif dernière ligne de wsmodif
For i = 2 To dlmodif ' on parcourt toutes les lignes de wsmodif
       Set re = wsbase.Range(uidbase & "2:" & uidbase & dlbase).Find(wsmodif.Range(uidmodif & i)) ' on recherche l'identifiant unique de wsmodif dans wsbase
       If re Is Nothing Then 'si on ne le trouve pas on ajoute une ligne dans base
           dlbase = dlbase + 1
            wsbase.Rows(dlbase).Insert shift:=xlDown
            wsbase.Range(actionbase & dlbase) = copydata(i, dlbase)
        Else ' sinon on copie les données modifiées
           wsbase.Range(actionbase & re.Row) = copydata(i, re.Row)
        End If
    Next i
    Set re = Nothing
    Set wsr = Nothing
    Set wsbase = Nothing
    Set wsmodif = Nothing
End Sub

Function copydata(a, b)
'copie les données de la wsmodif ligne a vers wsbase ligne b en fonction du tableau de relation
   r = Empty
    For i = 2 To dlr ' on parcourt toutes les colonnes à copier
       If wsr.Range("D" & i) <> "" Then
            cols = wsr.Range("D" & i) ' cols identifiant de la colonne source à copier
           colt = wsr.Range("A" & i) ' colt identifiant de la colonne cible
           If wsbase.Range(colt & b) <> wsmodif.Range(cols & a) Then wsbase.Range(colt & b) = wsmodif.Range(cols & a): r = 1 ' on copie si différent entre source et cible
       End If
    Next i
    copydata = r
End Function

Je n'arrive pas vraiment à bien comprendre mais bon...

Je viens de remarquer une chose, il faudrait que la colonne pour le pays soit remplie avec des BE en fait.

En modifiant le code

actionbase = wsr.Range("B1:B" & dlr).Find("UPDATE_ACTION").Offset(0, -1).Value 'actionbase colonne de wsbase contenant l'action
   wsbase.Range(actionbase & "2") = 3 ' par defaut toutes les lignes sont à supprimer
   wsbase.Range(actionbase & "2").Copy
    wsbase.Activate
    wsbase.Range(actionbase & "3:" & actionbase & dlbase).Select
    wsbase.Paste

en :

actionbase = wsr.Range("B1:B" & dlr).Find("COUNTRY").Offset(0, -1).Value 'actionbase colonne de wsbase contenant l'action
   wsbase.Range(actionbase & "2") = BE ' par defaut toutes les lignes sont à supprimer
   wsbase.Range(actionbase & "2").Copy
    wsbase.Activate
    wsbase.Range(actionbase & "BE:" & actionbase & dlbase).Select
    wsbase.Paste

Et en le mettant à la fin, cela va t il fonctionner?

re-bonjour,

avec les modifications suivantes, cela devrait le faire, à tester. (par contre ces lignes vont être systématiquement marquées comme modifiées si dans modif ("fichier_source.xls") il y a autre chose que "BE".

actionbase = wsr.Range("B1:B" & dlr).Find("COUNTRY").Offset(0, -1).Value 'actionbase colonne de wsbase contenant l'action
   wsbase.Range(actionbase & "2") = "BE" ' par defaut country est BE pour toutes les lignes
   wsbase.Range(actionbase & "2").Copy
    wsbase.Activate
    wsbase.Range(actionbase & "3:" & actionbase & dlbase).Select
    wsbase.Paste

Re-bonjour,

Et en modifiant le BELGIE en BE dans Fichier_source et puis faire la comparaison? Ainsi lors de la comparaison on utilise la valeur utilisée dans Fichier_à_mettre_à_jour

Encore un grand merci pour ton aide en tout cas

bonsoir,

on proposition à tester,

Dim wsr, wsbase, wsmodif, dlr, dlbase, dlmodif
Sub miseajour()

    Set wsr = Workbooks("relation.xlsm").Worksheets("sheet1") ' wsr feuille relation
  Set wsbase = Workbooks("fichier_à_mettre_à_jour.xlsx").Worksheets("Plan1") ' wsbase feuille maitre
  Set wsmodif = Workbooks("fichier_source.xlsx").Worksheets("Plan1") ' wsmodif feuille avec les modifications
  dlr = wsr.Range("A" & Rows.Count).End(xlUp).Row ' dlr dernière ligne relation
  uidbase = wsr.Range("B1:B" & dlr).Find("STORE_ID").Offset(0, -1).Value ' uidbase colonne de wsbase contenant l'identifiant unique
  dlbase = wsbase.Range(uidbase & Rows.Count).End(xlUp).Row ' dlbase dernière ligne de wsbase
  actionbase = wsr.Range("B1:B" & dlr).Find("UPDATE_ACTION").Offset(0, -1).Value 'actionbase colonne de wsbase contenant l'action
  wsbase.Range(actionbase & "2") = 3 ' par defaut toutes les lignes sont à supprimer
  wsbase.Range(actionbase & "2").Copy
    wsbase.Activate
    wsbase.Range(actionbase & "3:" & actionbase & dlbase).Select
    wsbase.Paste
country = wsr.Range("B1:B" & dlr).Find("UPDATE_ACTION").Offset(0, 2).Value 'country colonne de wsmodif contenant country
  wsmodif.Range(country & "2") = "BE" 'on met BE comme Country dans toutes les lignes modif
  wsmodif.Range(country & "2").Copy
    wsmodif.Activate
    wsmodif.Range(country & "3:" & country & dlmodif).Select
    wsmodif.Paste
    uidmodif = wsr.Range("C1:C" & dlr).Find("StoreNRID").Offset(0, 1).Value ' uidmoif colonne de wsmodif contenant l'identifiant unique
  dlmodif = wsmodif.Range(uidmodif & Rows.Count).End(xlUp).Row ' dlmodif dernière ligne de wsmodif
For i = 2 To dlmodif ' on parcourt toutes les lignes de wsmodif
       Set re = wsbase.Range(uidbase & "2:" & uidbase & dlbase).Find(wsmodif.Range(uidmodif & i)) ' on recherche l'identifiant unique de wsmodif dans wsbase
       If re Is Nothing Then 'si on ne le trouve pas on ajoute une ligne dans base
           dlbase = dlbase + 1
            wsbase.Rows(dlbase).Insert shift:=xlDown
            wsbase.Range(actionbase & dlbase) = copydata(i, dlbase)
        Else ' sinon on copie les données modifiées
           wsbase.Range(actionbase & re.Row) = copydata(i, re.Row)
        End If
    Next i
    Set re = Nothing
    Set wsr = Nothing
    Set wsbase = Nothing
    Set wsmodif = Nothing
End Sub

Function copydata(a, b)
'copie les données de la wsmodif ligne a vers wsbase ligne b en fonction du tableau de relation
  r = Empty
    For i = 2 To dlr ' on parcourt toutes les colonnes à copier
      If wsr.Range("D" & i) <> "" Then
            cols = wsr.Range("D" & i) ' cols identifiant de la colonne source à copier
          colt = wsr.Range("A" & i) ' colt identifiant de la colonne cible
          If wsbase.Range(colt & b) <> wsmodif.Range(cols & a) Then wsbase.Range(colt & b) = wsmodif.Range(cols & a): r = 1 ' on copie si différent entre source et cible
      End If
    Next i
    copydata = r
End Function

Oups, avec un peu de retard merci de ta réponse, en fait j'ai modifié dans mon fichier source en mettant BE partout dans les collones, c'est rapide et facile.

Sinon le script marche super bien, et il est facilement modifiable pour comparer d'autres tableaux.

Encore un grand merci de ton aide