Ventiler une base en feuilles et onglets - VBA
Bonjour à tous,
Débutant en VBA, je me lance dans mon 1er gros projet. J’ai beau éplucher les forums je ne trouve pas la solution
Mon problème : Je dispose d’une base de données (TEST). Je souhaiterais :
- Étape 1 : Ventiler la base TEST sur plusieurs classeurs sur la base du champ CRITERE 1 (colonne N). Ces feuilles doivent être les mêmes que la base de données sur la forme et le fond (maintien des formules entre autre). Idéalement le classeur prendrait le nom du critère.
- Étape 2 : Sur l nouveau classeur crée, en plus du 1er onglet qui reprendrait toutes les données du CRITERE 1, il faudrait ventiler ce 1er onglet sur plusieurs autres onglets sur la base du CRITERE 2 (colonne O). Idem maintien du tableau tel qu’il est et attribution d’un nom à l’onglet sur la base du critère 2.
Cela fait 2 jours que je fais des tests dans tous les sens mais rien à faire, aucune de mes macros ne fonctionnent.
Merci par avance pour votre aide.
Lilma
Bonjour,
Voici une de mes anciennes réalisations
le code n'est certainement ps optimisé !
à enchaîner sur ...
Bonjour, Salut Steelson !
Une première mouture fonctionnelle...
Sub Ventilation()
Dim plgET As Range, d1 As Object, d2 As Object, n&, i&, j&, k, kk, klg
Dim wsS, chD$, Llg()
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
With ActiveSheet
n = .Cells(.Rows.Count, 14).End(xlUp).Row
For i = 10 To n
k = .Cells(i, 14): kk = .Cells(i, 15)
If InStr(1, d1(k), kk) = 0 Then d1(k) = d1(k) & ";" & kk
d2(k & kk) = d2(k & kk) & ";" & i
Next i
Set plgET = .Range("A1").Resize(9, 51)
wsS = .Range("A1:AY" & n)
End With
chD = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
For Each k In d1.keys
kk = Split(d1(k), ";"): n = UBound(kk)
With Workbooks.Add(xlWBATWorksheet)
.SaveAs chD & k & ".xlsx", xlOpenXMLWorkbook
If n > 1 Then .Worksheets.Add after:=Worksheets(1), Count:=n - 1
For i = 1 To n
With .Worksheets(i)
.Name = kk(i)
With .Cells.Font
.Name = "Arial": .Size = 7
End With
plgET.Copy
With .Range("A1")
.PasteSpecial xlPasteAll
.PasteSpecial xlPasteColumnWidths
End With
klg = Split(d2(k & kk(i)), ";")
ReDim Llg(1 To UBound(klg))
For j = 1 To UBound(klg)
Llg(j) = WorksheetFunction.Index(wsS, CLng(klg(j)), 0)
Next j
With .Range("A10:AY" & UBound(klg) + 9)
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Llg))
.Borders.Weight = xlThin
End With
End With
Next i
.Close True
End With
Next k
End SubJ'ai encore quelques améliorations à tenter... à suivre.
Cordialement.
Version définitive...
Sub Ventilation()
Dim plgET As Range, d1 As Object, d2 As Object, n&, i&, j&
Dim k, kk, klg, wsS, chD$, Llg()
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
With ActiveSheet
n = .Cells(.Rows.Count, 14).End(xlUp).Row
Set plgET = .Range("A1").Resize(9, 51)
wsS = .Range("A1:AY" & n)
End With
For i = 10 To n
k = wsS(i, 14): kk = wsS(i, 15)
If InStr(1, d1(k), kk) = 0 Then d1(k) = d1(k) & ";" & kk
d2(k & kk) = d2(k & kk) & ";" & i
Next i
chD = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
For Each k In d1.keys
kk = Split(d1(k), ";"): n = UBound(kk)
With Workbooks.Add(xlWBATWorksheet)
.SaveAs chD & k & ".xlsx", xlOpenXMLWorkbook
If n > 1 Then .Worksheets.Add after:=Worksheets(1), Count:=n - 1
For i = 1 To n
With .Worksheets(i)
.Name = kk(i)
With .Cells.Font
.Name = "Arial": .Size = 7
End With
plgET.Copy
With .Range("A1")
.PasteSpecial xlPasteAll
.PasteSpecial xlPasteColumnWidths
End With
.Activate: .Range("A1").Select
klg = Split(d2(k & kk(i)), ";")
ReDim Llg(1 To UBound(klg))
For j = 1 To UBound(klg)
Llg(j) = WorksheetFunction.Index(wsS, CLng(klg(j)), 0)
Next j
With .Range("A10:AY" & UBound(klg) + 9)
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Llg))
.Borders.Weight = xlThin
End With
End With
Next i
.Worksheets(1).Activate
.Close True
End With
Next k
End SubCela reste toutefois relativement lent, avec le double collage de l'en-tête... 1seconde et demi, on n'a que 7 lignes, qui cependant conduisent à 3 classeurs et 5 feuilles, donc 5 collages. Si le nombre de collage n'augmente pas proportionnellement aux lignes, cela compensera un peu car pour le transfert des lignes pas de collage du tout.
Si un gain de temps se révélait nécessaire, il faut ôter cette ligne :
.Activate: .Range("A1").Selectappliquée sur chaque feuille après collage (pour désélectionner la zone collée), et celle-ci :
.Worksheets(1).Activateappliqué sur chaque classeur créé avant fermeture (pour qu'il s'ouvre sur la première feuille).
On y perdra en esthétique, mais s'il faut gagner du temps, il n'y a que ça...
Les classeur créés vont dans le dossier du classeur d'origine. S'ils doivent aller ailleurs, il faut modifier le chemin défini dans la variable chD.
Cordialement.
Bonjour,
Merci beaucoup pour votre aide à tous les 2, la solution de MFERRAND m'a l'air très opérationnel.
Je vais pouvoir m'amuser à decortiquer le code pour le comprendre maintenant
Merci!
Bonjour,
Honnêtement, je dois te dire que dans un premier temps j'avais laissé ton sujet de côté, parce que cela me semblait un peu lourd à faire, et que conservant mise en forme et formule la voie tracée passait par du copier-coller que je n'éprouve qu'un intérêt modéré à faire... puis j'ai abandonné un autre sujet en cours, parce sa poursuite dans des conditions modifiées ne me convenait plus, et suis retombé sur le tien en circulant...
Là j'ai regardé de plus près, et constaté qu'en fait, hors en-tête, la mise en forme des lignes ne reposait que sur la police et sa taille, ainsi que les bordures, soit une remise en forme très minime qu'on pouvait rétablir après transfert de valeurs sans copier-coller. Je m'y suis donc attaqué.
La méthode consiste d'abord pour préparer le travail à dimensionner la feuille source à traiter, puis on définit la plage d'en-tête (variable Range) qui sera copiée et collée, et on affecte toute la feuille dimensionnée à une variable Variant (sans faire de ségrégation, on sait qu'on traite à partir de la ligne 10), on obtient donc un tableau de valeurs dimensionné comme la feuille sur lequel on travaillera plus vite.
Phase analyse, on va constituer deux dictionnaires en parcourant les colonnes Critère1 et Critère2. Un dictionnaire est une collection d'éléments, clé/item ou valeur dans laquelle il ne peut y avoir de clé doublon, donc si j'appelle un élément dont la clé est constituée par le nom en critère1, s'il existe déjà c'est lui que j'aurai, s'il n'existe pas encore il sera créé : je l'appelle pour lui cumuler comme valeur le nom en critère2, en veillant à ne rentrer chaque nom qu'une fois (et en séparant chaque nom par un point-virgule). En fin de parcours du tableau, mon dico sera composé d'autant d'éléments qu'il y a de noms différents dans critère1 (mes classeurs à créer), et chaque élément contiendra une liste critère2 qui lui est rattachée (les feuilles du classeurs).
Simultanément, je constitue un 2e dico dont la clé des éléments est constitué par le nom en critère1 et celui en critère2 accolés (identification classeur-feuille que l'on pourra retrouver sans ambiguïté), comme contenu de ce dico (toujours séparés par des ";") les numéros de lignes (afin de les récupérer pour chaque feuille plus rapidement).
Une fois ces infos accumulées, une première boucle pour parcourir le dico1, clé par clé, on extrait le contenu (en splittant pour obtenir un tableau), le nb d'éléments du tableau fournit le nb de feuilles, on crée le classeur et l'enregistre, on ajoute les feuilles nécessaires s'il y a lieu, puis boucle pour parcourir chaque feuille : on la nomme, on ajuste la police d'emblée, et copie de la plage en-tête et double collage (le second pour la largeur des colonnes).
A ce stade on se tourne vers le 2e dico, l'élément correspondant à la feuille, on extrait en tableau les numéros de lignes à placer dans la feuille, et là c'est la partie que tu auras sans doute un peu plus de mal à décortiquer : on dimensionne un tableau à une dimension sur le nombre de lignes qui seront à placer dans la feuille, on alimente ce tableau en allant chercher ces lignes dans notre tableau source et en extrayant chaque ligne au moyen de la fonction Excel INDEX utilisée sous sa forme matricielle (tableau, n° de ligne, 0 pour colonne, et elle renvoie la ligne entière sous forme de matrice), on a donc un tableau à une dimension dont chaque élément est lui-même composé d'un tableau à une dimension. On affecte un tableau unidimensionnel à une plage-ligne, pour l'affecter à un plage-colonne il faut le transposer, et dans ce cas d'un tableau de tableaux on opère une double-transposition, qui permet de retablir les lignes à leur place et réparties correctement dans les colonnes...
J 'ai tenté ça de nombreuses fois au fil des ans, de diverses façons en obtenant toujours des erreurs... Maintenant que j'ai trouvé la solution (grâce à un membre du Forum DDetP88, qu'il en soit salué !), je rôde l'exercice
Cordialement et bonne continuation.
Merci Maréchal, et en plus tu es un roi de la prose
Je vais m'en inspirer pour m'améliorer.
Re,
Après avoir regardé de plus près le résultat j'ai un petit et un gros souci (ou pas) :
1 - J'ai inséré dans certaines colonnes de ma base de données des formules. Quand je le fais et que j'applique la ventilation, les formules ne sont pas reprises. J'ai changé .PasteSpecial xlPasteAll en .PasteSpecial xlPasteFormulas mais ça ne marche pas. En PJ (V14), un exemple de formule que j'ai inséré en colonne AV
2 - Les classeurs se génèrent bien avec dispatch selon le critère 2. En revanche il faudrait sur chacun des classeurs un onglet qui reprenne toutes les lignes du critère 1. Peut être que ce n'est pas possible et qu'il faut que j'insère un code de "consolidation" dans chacun des fichiers générés ?
Si je ne suis pas clair, voilà un exemple de la cible en PJ (Alain) avec l'onglet rouge ALAIN.
Merci encore pour le temps consacré
J'ai zappé ce premier onglet... Oui, c'est faisable, mais on va allonger, on reprend toutes les lignes une 2e fois, pas de problèmes... on peut cependant essayer de constituer ce tableau simultanément aux autres, pour éviter de faire deux fois la même boucle.
A moins que tu ne les veuilles dans le même ordre que sur le fichier source, auquel cas c'est un élément dico (type : AlainAlain) avec ses lignes qui doubleront les autres, mais sans changer la phase suivante. C'est peut-être d'ailleurs la meilleure solution parce le dico est un outil extrêmement rapide...
Les formules, tu as 3 fois rien dans le tableau !
Je comprendrais mieux s'il y en avait sur toute cette partie du tableau. En tout cas cela peut être rapidement rétabli, pas plus de temps que rétablir les bordures...
Cordialement.
Salut Steelson !
Re MFerrand
Concernant le fameux 1er onglet en fait peu importe l'ordre des lignes.
Pour les formules effectivement en AN c’est une fausse formule et je vais la copier en valeur ca sera plus simple. En revanche j'en aurais sur les colonnes AV/AW/AX sur une base de 1200 lignes.
Pour ton information, sur ma base complète le temps de traitement est d'environ 30 secondes c'est qui est insignifiant du point de vue du gain de temps!
Merci
et je vais la copier en valeur ca sera plus simple
Te casse pas la tête, pas de copie pour les données, c'est donc automatiquement en valeurs à l'arrivée.
Pour l'heure je n'ai vu qu'une formule en AV, il faut fournir les formules que tu veux sur ces 3 colonnes, on les introduira.
Voila dans le fichier en PJ (V15), les formules exactes en colonne AV et AW (Il n'y a pas de formule en fait en AX)
Bonjour,
Version réaménagée :
- 1er onglet,
- formules AV, AW,
- collage Formats sur données (trop pour les reprendre autrement).
Cordialement.
Merci beaucoup pour votre investissement c'est top!
Le problème est résolu, je ferme le sujet!