fusion des données

Version imprimable

16/11/2011, 22h17
Commandeur

fusion des données

Bonjour,

Voila je souhaiterais réunir des fichiers excel en un

voici ma conception:

Fichier:

Magasin1.xls
Magasin2.xls
Magasin3.xls
Magasin4.xls

En sachent que les fichiers on la même structure seul les donnée change.

Je souhaiterais les réunirs en un

Magasintotale.xls

Je voudrais savoir si c'est possible de le faire? si oui comment?

Merci de vos réponses

ERic

Bonjour
Voici un code qui le fait, il te faut mettre tes fichiers dans un répertoire, et adapte le chemin de ton répertoire dans le code dont j'ai mis "C:\Magasin tous"
Cordialement

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Public msg As String
 
Sub Appel() 'A ADAPTER
Dim Chemin As String
    Application.ScreenUpdating = False
        Chemin = "C:\Magasin tous\"
        Ouvrir Chemin
    Application.ScreenUpdating = True
    If msg <> "" Then _
    MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub
Sub Ouvrir(Chemin As String) 'Ouverture des classeurs d'un répertoire donné
Dim NomFich As String
Dim CL2 As Workbook 'fichier copié
    Application.DisplayAlerts = False 'Evite les messages d'Excel
    'Evite l'exécution éventuelle de macros liées aux fichiers ouverts
    Application.EnableEvents = False
        NomFich = Dir(Chemin & "*.xls")
        If NomFich = "" Then
             MsgBox "Aucun fichier trouvé dans " & Chemin
             Exit Sub
        End If
        Do While NomFich <> ""
            Set CL2 = Workbooks.Open(Chemin & NomFich)
            DoEvents
            Copie CL2
            CL2.Close False
            DoEvents
            ThisWorkbook.Save 'enregistrement du classeur après chaque copie
            DoEvents
            NomFich = Dir
        Loop
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub
Sub Copie(CL2 As Workbook) 'Copie à la suite, dans une feuille unique, des données de toutes les feuilles du classeur CL2
 
Dim LaFeuille As Worksheet, FL1 As Worksheet, derlig As Long
    Set FL1 = ThisWorkbook.Worksheets("feuil1") 'feuille où les données sont collées
    For Each LaFeuille In CL2.Worksheets 'parcours du classeur à copier
        'On vérifie que la feuille n'est pas vide
        If Not (LaFeuille.UsedRange.Address = "$A$1" And Range("A1") = "") Then
            derlig = FL1.Range("A" & Rows.Count).End(xlUp).Row + 1 'première ligne vide
            On Error Resume Next
            LaFeuille.UsedRange.Copy FL1.Cells(derlig, 1)
            DoEvents
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                On Error GoTo 0
            End If
        End If
    Next
End Sub

17/11/2011, 23h18
Commandeur

1 pièce(s) jointe(s)

Bonjour,

merci de ton aide, mais sa marche pas trop bien,

Voila j'ai suivi que tu m'a dit, jai mis mes trois fichier excel dans le même dossier
J'ai copier la macro dans mon fichier magasin0. Sa fonctionne pas?

Je t’envoie se que j'ai fait.

Juste une précision sur se que je recherche;
Mes trois fichiers on le même tableau avec des données différentes

Une colonne Ref produit et une autre stock et désignation.

Apres la fusion voici se que jattend :

Nom magasin , ref produit, stock ,désignation

Magasin1 , 1233 ,30, Roulo
Magasin2 , 1233 ,15, Roulo
Magasin3 , 1233 ,0, Roulo
Magasin1, 2344,20,Terreau

J’espère que j'ai été claire dans mon explication?
Je t'envois mes fichiers d'exemples.

Merci baucoup

1 pièce(s) jointe(s)

Bonjour
J'ai mis les 3 fichiers 'Magasin1' 'Magasin2' 'Magasin3' dans le répertoire 'Magasin tous' à la racine de C:\
J'ouvre le fichier 'Magasin0' dans mes documents qui a le code, je lance le code parAlt+F8 et voici le résultat ci-dessous:

Ref Produit1 Qte
12 Tuyau 20
Ref Designation Stock
12 Tuyau 40
Ref Designation Stock
12 Tuyau 1220
67 clee carre 140

Ce code ne mets pas le nom du fichier sur chaque ligne, et on retrouve toutes les données de tes 3 fichiers.

Cordialement

Bonjour
Puisque dans ton deuxième message tu veux avoir Magasin1 en colonne A, il faut que tu insères cette colonne qui manque dans tes fichiers Magasin1, Magasin2, magasin3.
Je te propose aussi un autre code qui te demandera de sélectionner le répertoire qui contient tes fichiers Magasin1, Magasin2, Magasin3.
Ce code nécessite d'activer la reference Microsoft Scripting RunTime par VBA Outils Références cocher Microsoft Scripting RunTime.
Voici le code:

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Option Explicit
Sub Concatener()
Dim Classeur_Maitre As Workbook, Classeur_Slave As Workbook
Dim oShell As Object, oFolder As Object
Dim oFolderItem As Object
Dim Tab_Files As Variant
Dim aFile As Variant
Dim ValueB7 As String
Dim Cel As Range
Application.DisplayAlerts = False
Set Classeur_Maitre = ActiveWorkbook
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
If oFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical
    Exit Sub
Else
  Set oFolderItem = oFolder.Self
End If
Tab_Files = ListFilesInFolder(oFolderItem.Path, False)
For Each aFile In Tab_Files
   '................................................................................................................
    Set Classeur_Slave = Workbooks.Open(aFile, ReadOnly:=True)
    'Ouvre classeur Slave sheet 1 et copie
     Classeur_Slave.Sheets(1).Range("A2:D1000").Copy
    'Copie du classeur Slave et le colle en collage spécial valeurs dans le Classeur Maitre de la sheet 1
    With Classeur_Maitre.Sheets(1).Range("A65536").End(xlUp)
            .Offset(1, 0).PasteSpecial Paste:=xlValues
    End With
    '...................................................................................................................
    Classeur_Slave.Close False 'ferme le classeur Slave et boucle sur le prochain classeur Slave du répertoire
Next
Classeur_Maitre.Sheets(1).Range("A1").Activate
End Sub
 
Function ListFilesInFolder(strFolderName As String, Optional bIncludeSubfolders As Boolean = False, Optional strTypeFichier As String) As Variant
  ' necessite d'activer la reference Microsoft Scripting RunTime par VBA Outils Références cocher Microsoft Scripting RunTime
  Static FSO As FileSystemObject
  Static bNotFirstTime As Boolean
  Static tabType As Variant, vType As Variant
  Static dicoType As Object
  Static strResult As String
  Dim bTheFirst As Boolean
  Dim oSourceFolder As Scripting.Folder
  Dim oSubFolder As Scripting.Folder
  Dim oFile As Scripting.File
  bTheFirst = False
    If Not bNotFirstTime Then
    bTheFirst = True
        Set FSO = CreateObject("Scripting.FileSystemObject")
    Set dicoType = CreateObject("Scripting.Dictionary")
    If strTypeFichier <> "" Then
        tabType = Split(strTypeFichier, ";")
        For Each vType In tabType
            dicoType.Add vType, "Ext"
        Next
    End If
    bNotFirstTime = True
        On Error Resume Next
    Set oSourceFolder = FSO.GetFolder(strFolderName)
    On Error GoTo 0
    If oSourceFolder Is Nothing Then
      MsgBox "Le répertoir '" & strFolderName & "' n'existe pas." & vbCrLf & "L'execution va prendre fin.", vbExclamation, "Répertoir inconnu"
      GoTo finApp
    End If
    End If
    Set oSourceFolder = FSO.GetFolder(strFolderName)
  For Each oFile In oSourceFolder.Files
    If dicoType.Exists(ExtractFileExt(oFile.Name)) Or (strTypeFichier = "") Then
        strResult = strResult & oFile.Path & ";"
    End If
  Next oFile
  If bIncludeSubfolders Then
    For Each oSubFolder In oSourceFolder.SubFolders
          strResult = Join(ListFilesInFolder(oSubFolder.Path, True), ";") & ";"
    Next oSubFolder
  End If
  If Right(strResult, 1) = ";" Then strResult = Left(strResult, Len(strResult) - 1)
  ListFilesInFolder = Split(strResult, ";")
finApp:
    If bTheFirst Then
    Set FSO = Nothing
    Set dicoType = Nothing
    bNotFirstTime = False
    tabType = ""
    vType = ""
    strResult = ""
  End If
End Function
Function ExtractFileExt(strName As String) As String
    If InStr(strName, ".") = 0 Then
        ExtractFileExt = ""
    Else
        ExtractFileExt = Mid(strName, InStrRev(strName, ".") + 1)
    End If
End Function

Voici le résultat:
Magasin Ref Designation Stock
Magasin1 12 Tuyau 20
Magasin2 12 Tuyau 40
Magasin3 12 Tuyau 1220
Magasin3 67 clee carre 140

Je te mets également le fichier Magasin0 qui contient le code avec un bouton de lancement du code.

Cordialement

20/11/2011, 11h01
Commandeur

Bonjour,

Je te remercie de ton code et de ta recherche pour mon problème. J'ai essayer de le faire mais il me prend que la premier ligne de mes fichiers. donc sa fonctionne pas trop bien.

Je vous explique a quoi sa vas me servir exactement, peut être il y une autre solution plus simple. Car je suis débutant sur excel, moi j'utilise access pour les base de donnée. Mais mon patron ne veux pas investir dans access. Bref;

Voila chaque magasin (environ 20 magasins) vont m'envoyer leurs fichiers excel qui contient les fiches produits, ces fichiers on une présentation identique est avec les mêmes référence des articles. Donc avec ces fichiers excel au nom du magasin je souhaiterais savoir le stock d'un article de chaque magasin

Exemple: je tape la référence du produit est sa me donne ceux-ci:

Réf : 3456 , désignation : tuyau 30 Mètre.

Magasin beaune stock 3
Magasin Buxy stock 20
Magasine Grenoble stock 500
Ect...

Mon soucis aussi c'est que chaque magasin à plus de 50 000 articles, donc je pense que je ne pourrais pas les mètres sur une feuilles excel, mais faire une feuilles par magasin; qu'en pensez vous?

Bien sur il faut que se soit rapide a faire car les donnée vont être mis a jours toute les semaines.

Merci beaucoup de votre aide.
20/11/2011, 13h59
Vadorblanc

Bonjour
Tu indiques:

Citation:

J'ai essayer de le faire mais il me prend que la premier ligne de mes fichiers. donc sa fonctionne pas trop bien.

As tu inséré une colonne A dans tes fichiers comme je t'ai demandé ? ce qui doit donner pour le Magasin3 :
Magasin3 Ref Designation Stock
Magasin3 12 Tuyau 1220
Magasin3 67 clee carre 140

Ensuite,quel Excel utilises tu? 2003, 2007 ou 2010, car dans Excel 2010 et Excel 2007, la taille des feuilles de calcul est de 16 384 colonnes par 1 048 576 lignes, mais la taille des feuilles de calcul Excel 97-2003 est de seulement 256 colonnes par 65 536 lignes.

Tu écrits:

Citation:

Exemple: je tape la référence du produit est sa me donne

Est ce une macro ? ou tapes tu la référence ?

Pour:

Citation:

50 000 articles, donc je pense que je ne pourrais pas les mètres sur une feuilles excel, mais faire une feuilles par magasin

Seulement ça va faire un gros fichier, et une recherche sur plusieurs feuilles empèche de faire un tri par références sur la même feuille, et 50 000 X 20 magasins, seul excel 2010 pourrait l'avoir, d'ou un code qui trouve la référence feuille sur la 1er feuille, puis sur la 2ème, etc... tu n'auras pas le résultat sur une même feuille...

C'est compliqué si tu n'as pas excel 2010, en de plus il sera presque au maxi d'une feuille.

Faut voir
20/11/2011, 14h16
Commandeur

Pour la reponse 1

rajouter une colonne dans chaque magasin c'est trop long, car j'en ai une 20 de magasin.

Je comprend le soucis des nombres de lignes, je pensse au boulot il sont sur la version 2007. je vais regarder sa lundi.

sinon j'ai une autre idée éventuellement,

c'est toujours faire une fusions mais en tableau croisée qui donnerais ceux ci:

Ref,designation, mag1,Mag2,mag3, ect..
------------------------------------
3456 , Tuyau 50m, 34 ,45,54 ,ect..
5678 , Rateau , 45,87,67, ect...

Comme chaque magasin on le même référence.

sa réduirai les nombres de lignes.

après c'est de savoir les fusionnée en tableau croise avec le nom des fichiers

éventuellement faire deux macros,
La premiere : rajouter le la colonne A avec le nom du fichier
La deuxieme : faire la fusion en tableau croise

Quant pense tu?
20/11/2011, 15h57
Vadorblanc

Re bonjour
Le problème Excel n'est pas fait pour gérer un nombre aussi important de référence, il y aura des temps d'attente aux recherches vite insupportables.

Au départ, ta demande concerne une fusion de fichiers, puis les données sont trop importantes pour une feuille d'Excel, et on comprend aisément, que si ton patron ne veut rien investir pour la coordination de ses 20 magasins, toi tu ne pourras pas faire des miracles.

Une autre piste, je ne sais pas sur quel version d'exploitation tu utilises, j'utilise Windows seven, et son moteur de recherche est surprenant de rapidité. Si tu récupères les 20 fichiers Excel chaque semaine et que tu les mets dans un répertoire (d'ailleurs je ne sais pas comment tu reçois ses fichiers, car 50 000 lignes par fichier ça devient vite compliqué par mail en pièce jointe), ensuite avec le moteur de recherche de Démarrer > Rechercher les programmes et fichiers, Recherche avancée, tu sélectionnes ton répertoire, et tu lance ta référence en recherche, tu as rapidement des résultats.

Je ne pourrais pas t'aider sur les tableaux croisés dynamiques que je ne maitrise pas suffisamment.

Cordialement