Autres Générer des feuilles et manipuler des données

kprint

XLDnaute Nouveau
Bonjour à tous,

Désolé pour ce titre de discussion pas très explicite, je suis tout nouveau sur le forum.
J'espère avoir des éclairages de ceux qui le voudront bien, la formation par l'exemple en quelque sorte.
Ci-joint 2 feuilles. Avec la KP01 je souhaiterais générer des feuilles (l'idéal serait un classeur) par codedept, chaque feuille contenant une liste codeart, nomart, qte.
Avec la KP02, je souhaiterais générer une feuille par codedept et contenant le cumul de MT.
Evidemment je ne souhaite pas du pré-maché, mais plus une orientation, un exemple, que je pourrais approfondir.
Je remercie par avance ceux qui voudront bien m'aiguiller et je salut tout le monde.
 

Fichiers joints

Robert

XLDnaute Barbatruc
Bonjour Kprint, bonjour le forum,

Pour KP01 le code ci-dessous :

VB:
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableu des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("KP01") 'définit l'onglet source OS
CA = CS.Path & "\" 'définit le chemin d'accès CA
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonne NC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 3)) = "" 'alimente le dictionnaire D avec les données en colonne 3 du tableau des valeurs (CODEDEPT)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des données du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les élément du tableau temporaire TMP
    Set CD = Application.Workbooks.Add 'définit le classeur Destination CD (nouveau classeur vierge)
    CD.SaveAs (CA & TMP(J) & ".xls") 'enregistre le classeur sous
    Set OD = CD.Worksheets(1) 'definit l'onglet destination
    OD.Name = TMP(J) 'renomme l'onglet destination
    OD.Range("A1").Resize(1, NC).Value = Application.Index(TV, 1) 'renvoie la première ligne du tableau des valeurs TV dans la cellule A1 redimensionnée de l'onglet destination OD
    Erase TL: K = 1 'efface le tableau TL et réinitialise la variable K
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 3) = TMP(J) Then 'condition : si la donnée ligne de la boucle 2 colonne 3 est égale à l'élément de la boucle 1
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    'si K est supérieur à 1, renvoie le tableau TL transposé dans la cellule A2 redimensionnée de l'onget OD
    If K > 1 Then OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
Next J 'prochain élément de la boucle 1
End Sub

Pour KP02 le code ci-dessous :

Code:
Sub Macro2()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableu des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("KP02") 'définit l'onglet source OS
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonne NC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 2)) = "" 'alimente le dictionnaire D avec les données en colonne 2 du tableau des valeurs (CODEDEPT)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des données du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les élément du tableau temporaire TMP
    Set OD = Application.Worksheets.Add 'définit l'onglet Destination OD (nouvel onglet vierge)
    OD.Name = TMP(J) 'renomme l'onglet source
    OD.Move after:=Sheets(Sheets.Count) 'déplace l'ongelt en dernière position
    OD.Range("A1").Resize(1, NC).Value = Application.Index(TV, 1) 'renvoie la première ligne du tableau des valeurs TV dans la cellule A1 redimensionnée de l'onglet destination OD
    Erase TL 'efface le tableau TL et réinitialise la variable K
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 2) = TMP(J) Then 'condition : si la donnée ligne de la boucle 2 colonne 2 est égale à l'élément de la boucle 1
            ReDim Preserve TL(1 To NC, 1) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC - 1 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, 1) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 3
            TL(NC, 1) = CDbl(TL(NC, 1)) + CDbl(TV(I, NC)) 'ajoute les MT
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    If K > 1 Then 'condition : si K est supérieur à 1
        For I = 1 To UBound(TL, 1) 'boucle sur toutes les lignes I de TL
            OD.Cells(2, I).Value = TL(I, 1) 'renvoie dans la cellule ligne 2 colonne I de l'onget OD la valeur de la donnée ligne I colonne 1 de TL
        Next I 'prochaine ligne de la boucle
    End If 'fin de la condition
    Next J 'prochain élément de la boucle 1
End Sub
Plutôt que de créer un onglet par code, j'aurais plutôt fait un tableau dans un seul onglet reprenant tous les codes...
 

kprint

XLDnaute Nouveau
Merci Robert pour votre réactivité et votre aide...je n'ai plus qu'à me pencher là dessus...
A tout hasard , sans lire dans le marc de café :), pensez vous que les instructions sont compatibles avec Libreoffice ? dans tous les cas j'essayerais
Merci encore
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil,

Libre Office peut éxécuter du code VBA "basique"
Voir ici par exemple pour plus de détails

Par contre pas sur qu'il puisse exécuter le code fourni par Robert (que je salue au passage)
 

Discussions similaires


Haut Bas