Répartir données selon critère

Niouf · 15 Décembre 2015

Bonjour,

Je souhaite sur le fichier joins, répartir mes données de l'onglet "Plan d'Action" Colonne 1 dans mon autre onglet "GANT".
Je m'explique: Il faudrait en fait répartir les valeurs ASS ... et SE ... dans deux tableaux.
En gros, je scanne ma colonne 1 (Onglet Plan d'action), je trouve un ASS ..., je le range dans mon tableau T12SA, je continu, je trouve un SE..., je le range à la suite dans mon tableau EPPSA.
Mes deux tableaux finaux sont sur le meme onglet, mais il est tout à fait possible de créer un onglet pour chaque.

Macro ou simple formule, je suis ouvert à tout.

Merci à ceux qui pourront me mettre sur une piste !

st007 · 15 Décembre 2015

Re : Répartir données selon critère

Ta colonne plan d'action H est évidemment indéfinie dans son nombre de lignes, ...
Les valeurs se et ass ne sont pas connues et figées, ....

il me semble donc quasi évident de créer deux onglets séparés..

un coup de filtre élaboré pour sortir chacune des valeurs ASS et SE, puis remplissage par formules index équiv

vgendron · 15 Décembre 2015

Re : Répartir données selon critère

Hello

voir le code ci dessous. à adpater très certainement
pour l'histoire de recouvrement, il suffit de lancer le code avec les tableaux déjà en partie remplis comme dans ton fichier exemple
sinon, penser à "vider" les tableaux

Code:

Sub range()

'la zone va sans doute etre dynamique. il faudra donc détecter la dernière ligne
Set zone = Sheets("Plan d'action").range("H18:H33")

For Each ele In zone
    If ele Like "*ASS*" Then
        tabdest = "T12SA"
    ElseIf ele Like "*SE*" Then
        tabdest = "EPPSA"
    End If
    'si les tableaux et leur tailles sont définies, pas de souci
    'sinon, il faudra penser à les séparer pour éviter un recouvrement..
    Select Case tabdest
        Case "EPPSA"
            Sheets("GANT").range("C37").End(xlUp).Offset(1, 0) = ele
        Case "T12SA"
            Sheets("GANT").range("C61").End(xlUp).Offset(1, 0) = ele
    End Select
    
Next ele
         
End Sub

Niouf · 15 Décembre 2015

Re : Répartir données selon critère

Messieurs,

Merci pour votre aide !

La macro marche pas mal du tout, je pense donc partir la dessus

Donc effectivement, j'ai detecté la dernière ligne

Ensuite, pour reprendre le conseil de st007, j'ai séparé mes tableaux EPPSA et T12SA en deux Onglets.
On peut rajouter une condition, SI SE, Copier la valeur dans l'Onglet GANT EPPSA, Etc ... ?
Et histoire de conserver mes calculs en bas de chaque tableau, j'aimerai insérer une ligne en copiant les valeurs. Possible aussi ?

vgendron · 15 Décembre 2015

Re : Répartir données selon critère

Avec un tableau par onglet (du meme nom que le tableau)

Code:

Sub range()

'la zone va sans doute etre dynamique. il faudra donc détecter la dernière ligne
Set zone = Sheets("Plan d'action").range("H18:H33")

For Each ele In zone
    If ele Like "*ASS*" Then
        tabdest = "T12SA"
    ElseIf ele Like "*SE*" Then
        tabdest = "EPPSA"
    End If
    'si les tableaux et leur tailles sont définies, pas de souci
    'sinon, il faudra penser à les séparer pour éviter un recouvrement..
    Select Case tabdest
        Case "EPPSA"
        Sheets("EPPSA").range("C655367").End(xlUp).Offset(1, 0) = ele
            
'            Sheets("EPPSA").range("C655367").End(xlUp).Offset(1, 0).Resize(2, 1).Select
'            Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            
    
'    Selection.Offset(-2, 0).Select
'    Selection.EntireRow.Copy
'    Selection.Offset(2, 0).Select.Resize(2, 0).Paste
    
'    Application.CutCopyMode = False
    
            
        Case "T12SA"
            Sheets("T12SA").range("C655367").End(xlUp).Offset(1, 0) = ele
    End Select
    
Next ele
         
End Sub

je pressentais bien que les deux lignes en bas allaient devoir etre déplacées.. et modifiées pour que les formules restent bonnes..
aussi, j'avais pensé à une table excel (pas tableau..) mais tu as de jolies cellules fusionnées..

à moins qu'on puisse inserer les nouvelles data en HAUT du tableau??

vgendron · 16 Décembre 2015

Re : Répartir données selon critère

Hello

ventilation des lignes dans le bon tableau, et mise à jour des formules dernière ligne avec ce code modifié.

Code:

Sub Ventiler()


'la zone va sans doute etre dynamique. il faut donc détecter la dernière ligne
lastline = Sheets("Plan d'action").range("H65536").End(xlUp).Row
Set zone = Sheets("Plan d'action").range("H18:H" & lastline)

For Each ele In zone
    If ele Like "*ASS*" Then
        Nomfeuille = "T12SA"
    ElseIf ele Like "*SE*" Then
        Nomfeuille = "EPPSA"
    End If
    'si les tableaux et leur tailles sont définies, pas de souci
    'sinon, il faudra penser à les séparer pour éviter un recouvrement..
    
    With Sheets(Nomfeuille)
        .Activate 'relativement bete comme opération. vu que le with sheet permet normalement de travailler sur la feuille sans l'ouvrir...
        'mais tant que je n'ai pas compris comment copier inserer des lignes SANS les sélectionner.. on reste comme ca
        'detection de la dernière ligne du tableau
        fin = .range("C65536").End(xlUp).Row
        
        'on déffusionne les colonnes A et B du tableau qui genent pour la copie...
        Cells(fin, 1).UnMerge
        
        'on copie colle les deux dernières lignes en fin de tableau: permet de garder les formules et mises en forme
        Rows(fin & ":" & fin + 1).Copy
        Rows(fin + 1).Select
        Selection.Insert Shift:=xlDown
        Application.CutCopyMode = False
        'on remerge les colonnes A et B
        range("A19:B" & fin + 3).Merge
        'on note le nom de la ligne
        range("C" & fin + 2) = ele
               
        
        'mise à jour des formules de la dernière ligne
        range("P" & fin + 4).Select
        formule = "=somme(P19:P" & fin + 3 & ")"
        ActiveCell.FormulaLocal = formule
        range("P" & fin + 4).Select
        Selection.AutoFill Destination:=range("P" & fin + 4 & ":S" & fin + 4), Type:=xlFillDefault
    End With
    
Next ele

         
End Sub

Niouf · 16 Décembre 2015

Re : Répartir données selon critère

Bug lors de l'insertion !

Je cherche d'ou ça peut venir, mais ...

st007 · 16 Décembre 2015

Re : Répartir données selon critère

Et le nom de tes onglets vont-ils t'inspirer ?

Nomfeuille = "EPPSA"
Nomfeuille = "T12SA"

vgendron · 16 Décembre 2015

Re : Répartir données selon critère

Re,
comme le dis st007 (hello), j'ai oublié de re-préciser que tes onglets devaient porter le nom des deux tableaux..

j'en profite pour poser une question:
dans tes tableaux, tu fusionnes les lignes 2 par 2 en colonne C..
sur la première ligne, on y voit des 4, 1 0.7 etc (je suppose que c'est la valeur de gain de la feuille Plan d'action)..
est ce que la deuxième ligne est destinée a recevoir aussi des info, ou elle est la, juste pour faire joli?

je demande car je sens que tu vas bientot nous dire que quand les tableaux sont vides, la macro plante...

Niouf · 17 Décembre 2015

Re : Répartir données selon critère

Ok j'ai compris merci

La ligne grise foncée est composée de formules, et elles sont copiées avec la macro donc pas de problème .
La ligne clair elle, va prendre des valeurs remplies manuellement, donc pas de problème à priori, il faut juste la laisser et la macro le fait très bien.

Effectivement je me rend compte des différentes contraintes au fur et à mesure.
Dans le tableau que je te joins, j'ai fais un essai avec une seule ligne, vierge, dans le cas ou on part du début d'année. Et la macro bug ici, je ne sais pas si tu voulais en venir la ...

Ensuite, j'aimerai aussi que la macro ne rajoute pas deux fois les memes actions. L'idée serait peut etre de scanner aussi sur les GANT, si l'action est déjà présente, et de ne pas rajouter celle ci à la suite ?
J'ai défini les zones à comparer, il faudrait donc rajouter une condition qui vérifie si la valeur AS.1.4 n'est pas déjà présente dans le tableau ?

Code:

'For Each ele In NomFeuille
'If ele = MyValue Then
'End If

Mon bouton ne ferait au final qu'une mise à jour ...

vgendron · 17 Décembre 2015

Re : Répartir données selon critère

Re

Et la macro bug ici, je ne sais pas si tu voulais en venir la ...

C'est exactement ca !

Je reviens vers toi plus tard pour cette histoire de bug "tableau vide" et de scan pour regarder si l'opération existe déjà ou pas

l'idée serait, je pense, de garder les deux premières lignes du tableau contenant les formules pour pouvoir les recopier

vgendron · 17 Décembre 2015

Re : Répartir données selon critère

Ci joint le fichier modifié, rendu vierge
j'ai ajoutté un bouton pour effacer les tableaux pour repartir de tableaux vierges

Niouf · 17 Décembre 2015

Re : Répartir données selon critère

Merci !

T'es au top

J'ai un ultime bug : Quand tu regardes ma somme en ligne noir, elle n'est pas égale à la véritable somme de la colonne.
Je pense que ça vient de la ligne vide qui reste en suspend en haut du tableau ...

vgendron · 17 Décembre 2015

Re : Répartir données selon critère

Re,

J'ai vu ton autre post pour le calcul des sommes lignes 15 et 16
Je t'avoue que je ne comprend pas bien comment fonctionne la formule, mais comme te l'a suggéré Cisco, et en adaptant les formules pour ignorer les deux premières lignes vide du tableau,
il faut remplacer le -2 par +1 dans la ligne jaune
et enlever le -2 dans la ligne noire..

Voir PJ

vgendron · 17 Décembre 2015

Re : Répartir données selon critère

J'avais pas vu que tu mettais la formule a partir du VBA..
donc il faut modifier le code comme ca

Code:

Sub Ventiler()

'la zone va sans doute etre dynamique. il faut donc détecter la dernière ligne
lastline = Sheets("Plan d'action").Range("H65536").End(xlUp).Row

'on suppose ici que le tableau commence TOUJOURS en ligne 18
Set zone = Sheets("Plan d'action").Range("H18:H" & lastline)

'selon le contenu de l'intitulé xxxASSxxx ou xxxSExxx, on adresse la feuille qui va bien
For Each ele In zone
    If ele Like "*ASS*" Then
        Nomfeuille = "T12SA"
    ElseIf ele Like "*SE*" Then
        Nomfeuille = "EPPSA"
    End If
    
       
    With Sheets(Nomfeuille)
        .Activate 'relativement bete comme opération. vu que le with sheet permet normalement de travailler sur la feuille sans l'ouvrir...
        'mais tant que je n'ai pas compris comment copier inserer des lignes SANS les sélectionner.. on reste comme ca
        
        'detection de la dernière ligne du tableau
        fin = .Range("C65536").End(xlUp).Row
        
        'tableau vide
        If fin = 16 Then fin = 17
        
        'on déffusionne les colonnes A et B du tableau qui genent pour la copie...
        'Cells(fin, 1).UnMerge
        
        'on regarde si l'action est déjà dans le tableau
        ActionExist = False
        For Each Action In ActiveSheet.Range("C17:C" & fin)
            If ele = Action Then
                ActionExist = True
                Exit For
            End If
        Next Action
        
        'si l'action n'existe pas, on l'insère
        If Not (ActionExist) Then
            'on copie colle les deux dernières lignes en fin de tableau: permet de garder les formules et mises en forme
            Rows(fin & ":" & fin + 1).Copy
            Rows(fin + 1).Select
            Selection.Insert Shift:=xlDown
            Application.CutCopyMode = False
            
            'on remerge les colonnes A et B
            ' range("A19:B" & fin + 3).Merge
            
            'on note le nom de la ligne
            Range("C" & fin + 2) = ele
               
            'mise à jour des formules de la dernière ligne
            Range("R" & fin + 4).Select
            formule = "=somme(R17:R" & fin + 3 & ")"
            ActiveCell.FormulaLocal = formule
            Range("R" & fin + 4).Select
            Selection.AutoFill Destination:=Range("R" & fin + 4 & ":U" & fin + 4), Type:=xlFillDefault
        End If
    End With
Next ele

'une fois que tous les éléments sont remplis, on ré-écrit les formules lignes noire et jaune

'dans la feuille EPPSA
Sheets("EPPSA").Select

'ligne Noire
Range("F15").Select
Selection.FormulaArray = _
        "=SUM(ISODD(ROW(OFFSET(R[4]C,,,MATCH(""zz"",R19C3:R1048532C3,1))))*IFERROR(1*OFFSET(R[4]C,,,MATCH(""zz"",R19C3:R1048532C3,1)),0))"
Selection.AutoFill Destination:=Range("F15:Q15"), Type:=xlFillDefault

'ligne Jaune
Range("F16").Select
Selection.FormulaArray = _
        "=SUM(ISEVEN(ROW(OFFSET(R[4]C,,,MATCH(""zz"",R19C3:R1048532C3,1))))*IFERROR(1*OFFSET(R[4]C,,,MATCH(""zz"",R19C3:R1048532C3,1)),0))"
Selection.AutoFill Destination:=Range("F16:Q16"), Type:=xlFillDefault

'dans la feuille T12SA
Sheets("T12SA").Select

'ligne Noir
Range("F15").Select
Selection.FormulaArray = _
        "=SUM(ISODD(ROW(OFFSET(R[4]C,,,MATCH(""zz"",R19C3:R1048532C3,1))))*IFERROR(1*OFFSET(R[4]C,,,MATCH(""zz"",R19C3:R1048532C3,1)),0))"
Selection.AutoFill Destination:=Range("F15:Q15"), Type:=xlFillDefault

'ligne Jaune
Range("F16").Select
Selection.FormulaArray = _
        "=SUM(ISEVEN(ROW(OFFSET(R[4]C,,,MATCH(""zz"",R19C3:R1048532C3,1))))*IFERROR(1*OFFSET(R[4]C,,,MATCH(""zz"",R19C3:R1048532C3,1)),0))"
Selection.AutoFill Destination:=Range("F16:Q16"), Type:=xlFillDefault


Sheets("Plan d'action").Activate

End Sub

Répartir données selon critère

Niouf

XLDnaute Occasionnel

Pièces jointes

st007

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Niouf

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Niouf

XLDnaute Occasionnel

Pièces jointes

st007

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Pièces jointes

Niouf

XLDnaute Occasionnel

Pièces jointes

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Pièces jointes

Niouf

XLDnaute Occasionnel

Pièces jointes

vgendron

XLDnaute Barbatruc

Pièces jointes

vgendron

XLDnaute Barbatruc

Discussions similaires