Création de plusieurs classeurs Excel

Y compris Power BI, Power Query et toute autre question en lien avec Excel
a
anthony1984
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 9 novembre 2019
Version d'Excel : 2013

Message par anthony1984 » 9 novembre 2019, 22:52

Bonjour,
je dois créer plusieurs fichiers suivant une base de donnée:

Colonne 1 Colonne 2 Colonne 3 Colonne 4
Fournisseur 1 ABC Commande 1 AZ
Fournisseur 1 ABC Commande 2 BY
Fournisseur 2 DEF Commande 3 AZ
Fournisseur 2 DEF Commande 4 AZ
Fournisseur 2 DEF Commande 5 BY
Fournisseur 3 GHI Commande 6 AZ


Suivant les données ci-dessus,
je dois créer des classeurs excel, avec comme onglet la colonne 4 (AZ ou/et BY)
et répéter sur ces onglets, les lignes concernées par fournisseur(colonne 1,2&3), ensuite j'ai besoin de l'enregistrer sous le nom de la colonne 1 et de la colonne 2 et en écrivant commande.
Et faire autant de fichier qu'il y a de fournisseur.
Est-ce possible de faire cette macro ?
Dans mon fichier, il y a plus de 1000 lignes avec 160 fournisseurs différents...
Merci pour votre aide.
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'160
Appréciations reçues : 734
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 10 novembre 2019, 04:46

Bonjour et bienvenue,

un outil qui peut t'aider
fragmenter un fichier.xlsm
(24.24 Kio) Téléchargé 6 fois

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
a
anthony1984
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 9 novembre 2019
Version d'Excel : 2013

Message par anthony1984 » 10 novembre 2019, 12:13

Merci beaucoup, c'est ce qu'il me faut
après j'aurai besoin de créer des onglets sur chaque fichier,
par rapport à une colonne qui indique deux valeurs différentes.
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'160
Appréciations reçues : 734
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 10 novembre 2019, 12:36

Si tu veux aller plus loi, poste n fichier exemple avec des valeurs quelconques.

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
a
anthony1984
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 9 novembre 2019
Version d'Excel : 2013

Message par anthony1984 » 10 novembre 2019, 13:23

Commande.xlsx
(9.35 Kio) Téléchargé 4 fois
Bonjour,
j'aurai besoin en plus de la fragmentation, d'ajouter deux onglets ou un seul en fonction de la colonne F.
Et cette colonne F ne doit plus apparaître dans mes fichiers.
Chaque ligne concernée doit aller dans le bon onglet.
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'160
Appréciations reçues : 734
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 11 novembre 2019, 05:51

Bonjour,

Je suis reparti de zéro, ce qui m'a permis de réaliser un code plus rapide.
Et comme j'aime bien commencer par des choses plutôt généralisables, pas trop spécifiques, je suis parti sur :
- 1ère colonne : nom du fichier
- 2ème colonne : nom de l'onglet

Après on peut "customiser" ...
Option Explicit

Sub fractionner()
Dim Tbl As Variant, data As Variant, i%, prov As String
Dim dico1 As Object, cle1 As Variant, result1 As Variant, prov1 As String
Dim dico2 As Object, cle2 As Variant, result2 As Variant, prov2 As String
Dim xl As Excel.Application, wb As Excel.Workbook
Dim MonRepertoire, Repertoire As FileDialog

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1)

    data = ActiveSheet.Cells(1, 1).CurrentRegion
    prov1 = data(1, 1): prov2 = data(1, 2)

    Set dico1 = CreateObject("Scripting.Dictionary")
    For i = LBound(data) + 1 To UBound(data) ' hors en-tête
        dico1(data(i, 1)) = dico1(data(i, 1)) & "|" & data(i, 2)
    Next
    
    Set dico2 = CreateObject("Scripting.Dictionary")
    For Each cle1 In dico1.Keys
        prov = dico1(cle1)
        Tbl = Split(prov, "|")
        dico2.RemoveAll
        For i = LBound(Tbl) + 1 To UBound(Tbl)
            prov = Tbl(i)
            dico2(prov) = ""
        Next
        dico1(cle1) = ""
        For Each cle2 In dico2.Keys
            dico1(cle1) = dico1(cle1) & "|" & cle2
        Next
    Next

    Set xl = CreateObject("Excel.Application")
    xl.SheetsInNewWorkbook = 1
    
    For Each cle1 In dico1.Keys
        Set wb = xl.Workbooks.Add
        xl.Visible = True
        Tbl = Split(dico1(cle1), "|")
        For i = LBound(Tbl) + 1 To UBound(Tbl) ' hors premier car la chaîne commence par le séparateur
            data(1, 1) = cle1: data(1, 2) = Tbl(i)
            result1 = FiltreArrayLignes(data, 1, cle1): result1(1, 1) = prov1
            result2 = FiltreArrayLignes(result1, 2, Tbl(i)): result2(1, 2) = prov2
            With wb.Worksheets.Add
                .Cells(1, 1).Resize(UBound(result2, 1), UBound(result2, 2)) = result2
                .Name = Tbl(i)
                .Columns("A:B").Delete Shift:=xlToLeft
            End With
        Next
        wb.SaveAs (MonRepertoire & "\" & cle1 & ".xlsx")
        wb.Close
        Set wb = Nothing
    Next
    xl.Quit
    Set xl = Nothing
    MsgBox "Terminé !"
    
End Sub

Function FiltreArrayLignes(Tbl, col, cle)
Dim i%, n%
' J. Boisgontier
' ne fonctionne pas si une seule occurence
  Dim tmp(): ReDim tmp(1 To UBound(Tbl))
  For i = LBound(Tbl) To UBound(Tbl)
    If Tbl(i, col) = cle Then n = n + 1: tmp(n) = i
  Next
  ReDim Preserve tmp(1 To n)
  FiltreArrayLignes = Application.Index(Tbl, Application.Transpose(tmp), _
    Application.Transpose(Evaluate("Row(1:" & UBound(Tbl, 2) & ")")))
End Function
fichier à fractionner.xlsm
(24.38 Kio) Téléchargé 4 fois

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message