Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaires

[phildefer]

Bonjour à tous,

Après avoir cherché mais pas trouvé, je me permets de faire appel à vos lumières d'experts en VBA car je sèche lamentablement sur la macro à réaliser.

Voilà le problème:
- fin janvier, je récupère un fichier de x lignes avec une colonne Identifiants et une colonne D pour un statut Traité (réponse = oui, non ou non concerné)
- fin février, je récupère un fichier de même structure mais de y lignes et pas forcément les mêmes occurrences.
- A partir de là je veux commencer à constituer un historique dans un fichier Résultat.xls où je vais reprendre les lignes de janvier + celles de février, en mettant 1 ligne par identifiant et en ayant le statut Traité de janvier dans une colonne, le statut Traité de février dans la colonne suivante.
- fin mars, je récupère un nouveau fichier de z lignes que je veux à son tour agréger au fichier Résultat obtenu fin février avec le statut Traité dans la colonne+1 par rapport à février

Je vous joints des exemples pour plus de clarté.
En espérant que vous pourrez m'aider.
Bonne journée à tous.

 

[job75]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Bonjour phildefer, bienvenue sur XLD,

Voyez le fichier joint et cette macro dans Module1 (Alt+F11) :

Sub CopierFichiers()
'se lance par Ctrl+A
Dim a, derlig As Long, n As Byte, Wb As Workbook, cel As Range, lig As Variant
Application.ScreenUpdating = False
Feuil1.Activate 'CodeName de la feuille de restitution
a = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", _
"Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
derlig = [A65536].End(xlUp).Row
For n = 1 To 12
  For Each Wb In Workbooks
    If Wb.Name Like a(n - 1) & "*" Then Exit For
  Next
  If Not Wb Is Nothing Then
    For Each cel In Wb.Sheets(1).Range("A2", Wb.Sheets(1).[A65536].End(xlUp))
      lig = Application.Match(cel, [A:A], 0)
      If IsError(lig) Then
        derlig = derlig + 1: lig = derlig
        Cells(lig, 1).Resize(, 3) = cel.Resize(, 3).Value
      End If
      Cells(lig, n + 3) = cel.Offset(, 3)
    Next
  End If
Next
End Sub

La macro se lance par les touches Ctrl+A.

A+

 

[phildefer]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Alors là, chapeau !!!
Merci tout d'abord pour la rapidité de la réponse. Ensuite, bravo car cela fonctionne parfaitement sur l'exemple.

Je vais tester en réel mais je pense que ça va fonctionner.

Par contre, il faut vraiment que je me penche sur ce sacré langage VBA. J'ai lu votre macro mais pas tout compris. Il va pourtant falloir car je vais devoir faire marcher ce principe sur d'autres fichiers qui auront une structure légèrement différente.

Comment se traduit la formule: If Wb.Name Like a(n - 1) & "*" Then Exit For ?

Pour l'instant, la logique ou plutôt le langage et la syntaxe VBA me sont étrangers. Connaitriez vous une adresse web de vulgarisation permettant d'acquérir les bases de la programmation sous excel ? (je sais enregistrer des séquences de touches pour en faire une macro mais ce n'est pas suffisant: la preuve!)

Encore merci
Philippe

 

[job75]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Re,

On peut éviter de construire un Array si le nom des feuilles est bien un mois "standard" (attention aux accents) :

Sub CopierFichiers()
'se lance par Ctrl+A
Dim derlig As Long, n As Byte, mois As String, Wb As Workbook
Dim cel As Range, lig As Variant
Application.ScreenUpdating = False
Feuil1.Activate 'CodeName de la feuille de restitution
derlig = [A65536].End(xlUp).Row
For n = 1 To 12
  mois = Application.Proper(Format("1/" & n, "mmmm")) 'avec une majuscule
  For Each Wb In Workbooks
    If Wb.Name Like mois & "*" Then Exit For
  Next
  If Not Wb Is Nothing Then
    For Each cel In Wb.Sheets(1).Range("A2", Wb.Sheets(1).[A65536].End(xlUp))
      lig = Application.Match(cel, [A:A], 0)
      If IsError(lig) Then
        derlig = derlig + 1: lig = derlig
        Cells(lig, 1).Resize(, 3) = cel.Resize(, 3).Value
      End If
      Cells(lig, n + 3) = cel.Offset(, 3)
    Next
  End If
Next
End Sub

Fichier (2).

A+

 

[phildefer]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Glurps !!!

J'ai pourtant fait un peu de programmation (il y a bien longtemps) mais là, il faut que je vois à tête reposée pour comprendre la logique. Je comprends le global mais le diable se cache dans le détail...

 

[Bebere]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

bonjour phildefer,job
une autre approche
les fichiers dans le même dossier

 

[job75]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Comment se traduit la formule: If Wb.Name Like a(n - 1) & "*" Then Exit For ?

Voyez l'aide VBA sur l'opérateur Like.

L'astérisque * est un caractère générique : l'extension des fichiers peut être .xls ou .xslx ou .xlsm.

Par ailleurs Application.Proper c'est la fonction NOMPROPRE des feuilles de calcul.

PS : utilisez au maximum l'Aide VBA.

A+

 

[phildefer]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Merci Job75: je n'avais pas pensé aux différents types d'extension xls, xlsm...

et merci aussi à Bebere: je vais regarder votre façon de voir les choses. Cela semble si simple de résoudre un problème de différentes manières...mais perso, je n'ai pas réussi.

 

[job75]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Re, salut Bebere,

Ouvrir tous les fichiers comme le fait Bebere est en effet une autre (bonne) solution.

C'est seulement un peu lourd s'il n'y a qu'un ou 2 mois à mettre à jour.

Voici ma macro adaptée à cette solution :

Sub CopierFichiers()
'se lance par Ctrl+A
Dim F1 As Worksheet, chemin$, derlig&, n As Byte, mois$
Dim fichier$, F2 As Worksheet, cel As Range, lig As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
Set F1 = Feuil1 'CodeName de la feuille de restitution
chemin = ThisWorkbook.Path & "\" 'dossier de tous les fichiers
F1.[A2:O65536].ClearContents 'RAZ
derlig = 1
For n = 1 To 12
  mois = Format("1/" & n, "mmmm")
  fichier = Dir(chemin & mois & "*")
  If fichier <> "" Then
    Set F2 = Workbooks.Open(chemin & fichier).Sheets(1)
    For Each cel In F2.Range("A2", F2.[A65536].End(xlUp))
      lig = Application.Match(cel, F1.[A:A], 0)
      If IsError(lig) Then
        derlig = derlig + 1: lig = derlig
        F1.Cells(lig, 1).Resize(, 3) = cel.Resize(, 3).Value
      End If
      F1.Cells(lig, n + 3) = cel.Offset(, 3)
    Next
    F2.Parent.Close False 'fermeture du fichier
  End If
Next
F1.Activate
End Sub

Fichier (3).

A+

 

[Bebere]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

oui Job, c'est une solution à affiner
ex:compléter la liste des mois et cliquer sur le mois à mettre à jour
j'attend ce que notre ami va dire

 

[phildefer]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Bonsoir à vous deux,

Job: j'ai essayé ta 1ère macro sur un cas réel. Ca fonctionne. Par contre, comment l'adapter pour un cas similaire mais où la clé de rapprochement (l'identifiant) n'est pas en colonne A ?

Bebere: je n'ai pas encore eu le temps de creuser à fonds ta solution mais à 1ère vue, j'avais l'impression de ne pas récupérer tous les enregistrements. Peut être que je me trompe mais il faut que je vérifie.

En tous cas, merci à vous.

 

[job75]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Job: j'ai essayé ta 1ère macro sur un cas réel. Ca fonctionne. Par contre, comment l'adapter pour un cas similaire mais où la clé de rapprochement (l'identifiant) n'est pas en colonne A ?

Si la structure des fichiers n'est pas celle de ceux du post #1 la macro doit évidemment être revue.

Vous ne semblez pas en mesure de le faire vous-même.

Si on a le temps on pourra le faire, mais joignez vos fichiers réels, allégés bien sûr.

A+

 

[phildefer]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Bonjour Job,

Avant tout, merci de bien vouloir me consacrer du temps.

Les fichiers exemples de mon 1er post correspondent à un cas réel et tout fonctionne bien.
Mais un autre applicatif me sort des fichiers structurés différemment pour lesquels je dois faire le même type de traitement.
Je mets en pièce jointe la structure du fichier mensuel et le fichier Résultat. Vous verrez: il y a beaucoup de similitudes, la différence se situant au niveau de la colonne de la clé de rapprochement qui est en colonne F ("N° de tiers") et non en colonne A.
(D'ailleurs votre macro du 1er cas marche très bien si je déplace cette rubrique "N° de tiers" de F en A, mais si je pouvais éviter de faire cette manip... question de fanéantise !!!)

Encore merci et bonne journée.

 

[job75]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Bonjour à tous,

oui Job, c'est une solution à affiner
ex:compléter la liste des mois et cliquer sur le mois à mettre à jour

Dans cette version (4) la macro CopierFichiers est paramétrée et se lance de 2 manières :

- par les touches Ctrl+A pour traiter tous les mois

- par double-clic dans la plage D1:O1 pour traiter un seul mois.

Le code dans Module1 :

Sub Tout()
'se lance par Ctrl+A
CopierFichiers 0
End Sub

Sub CopierFichiers(n As Byte)
Dim F1 As Worksheet, chemin$, derlig&, mois$
Dim fichier$, F2 As Worksheet, cel As Range, lig As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
Set F1 = Feuil1 'CodeName de la feuille de restitution
chemin = ThisWorkbook.Path & "\" 'dossier de tous les fichiers
If n = 0 Then F1.[A2:O65536].ClearContents 'RAZ
derlig = IIf(n, F1.[A65536].End(xlUp).Row, 1)
For n = IIf(n, n, 1) To IIf(n, n, 12)
  mois = Format("1/" & n, "mmmm")
  fichier = Dir(chemin & mois & "*")
  If fichier <> "" Then
    Set F2 = Workbooks.Open(chemin & fichier).Sheets(1)
    For Each cel In F2.Range("A2", F2.[A65536].End(xlUp))
      lig = Application.Match(cel, F1.[A:A], 0)
      If IsError(lig) Then
        derlig = derlig + 1: lig = derlig
        F1.Cells(lig, 1).Resize(, 3) = cel.Resize(, 3).Value
      End If
      F1.Cells(lig, n + 3) = cel.Offset(, 3)
    Next
    F2.Parent.Close False 'fermeture du fichier
  End If
Next
F1.Activate
End Sub

Dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [D1:O1]) Is Nothing Then Exit Sub
Cancel = True
CopierFichiers Val(Target)
End Sub

Edit : bonjour Philippe, nos messages se sont croisés, je regarde bien sûr votre post #13.

A+

 

[job75]

Re : Fusion de tableaux sous forme d'historique avec gestion d'identifiants similaire

Re Philippe,

Votre dernier fichier joint avec mes dernières macros adaptées.

Si votre fichier devait occuper plus de 65536 lignes sur Excel 2007/2010 dites-le (il faudra légèrement adapter la macro).

A+