Uniformiser sous tota VBA

Hoareau

XLDnaute Occasionnel
bonjour

J'essaie d'uniformiser un sous total
A chaque changement de col_concat, rajouter le sous total à NB_2


Trois tableaux qui proviennent d'une boucle
la colonne Nb_1 du 1 er tableau au maximum de 0 à 3
la colonne Nb_1 du 2 ème tableau au maximum de 0 à 4
la colonne Nb_1 du 3 ème tableau au maximum de 0 à 5

Je souhaiterai ramener la colonne NB_1 pour chacun des tableaux de 0 à 5,

avec des valeurs à 0 pour les données manquantes.

Pour résumer, pour chaque valeur de col_cat, il doit y avoir 5 lignes de 0

à 5

Dans la colonne à côté de NB_2, le % que représente chaque valeur par

rapport à son sous total



merci
 

Pièces jointes

  • Tri et sous total.xlsx
    10.6 KB · Affichages: 88

Staple1600

XLDnaute Barbatruc
Re : Uniformiser sous tota VBA

Bonjour à tous


Hoareau
Tu ne souhaites pas utiliser la fonction native d'Excel (dans Données/Sous-totaux) (avec ou sans VBA) ?
Voir ci-dessous
stotal.png
 

Staple1600

XLDnaute Barbatruc
Re : Uniformiser sous tota VBA

Re,

Ce qui en VBA donnerait
(code initial issu de l'enregistreur de macros)
VB:
Sub Macro1()
'Macro enregistrée le 24/11/2012 par Staple1600
'version classique et orthodoxe
Range("A2:C23").Subtotal _
                    GroupBy:=1, _
                    Function:=xlCount, _
                    TotalList:=Array(2, 3), _
                    Replace:=True, _
                    PageBreaks:=False, _
                    SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
End Sub
VB:
Sub Macro1b()
'Macro enregistrée le 24/11/2012 par Staple1600
'version "à ma sauce" et hérétique pour certains
'(mais comme j'ai un faible pour l'hérésie.. et ce en tout ;o)
[A2:C23].Subtotal 1, -4112, Array(2, 3), -1, 0, -1: ActiveSheet.Outline.ShowLevels 2
End Sub

EDITION: ->Hoareau:
Après mon premier café et relecture de ta question, je crois ne pas avoir bien compris celle-ci, n'est-ce pas ? :p
 
Dernière édition:

Hoareau

XLDnaute Occasionnel
Re : Uniformiser sous tota VBA

Merci pour la réponse, mais l'enregistreur ne peur rien dans ce cas,

puisqu'il faut insérer des lignes.

J'avais pensé à quelque chose de ce style

le fichier joint, donne une explication plus complète



Sub test()

Set B = [B2:B25]
i = 2
Do While Cells(i, 2).Row < B.Rows.Count

If Cells(i, 2) < 5 Then



'Je défini toute la plage en dessous de la cellule active
Set Transfert = Range(Cells(i, 2).Offset(0, -1), Cells(i, 2).Offset(0,

1).End(xlDown))
'Je copie la plage transfert, une cellule en dessous
Transfert.Copy Destination:=Cells(i, 2).Offset(-1, -1)

'J'ajoute 1, à la cellule active, par rapport à la cellule juste en dessus
Cells(i, 2) = Cells(i, 2).Offset(-1, 0) + 1



End If


i = i + 1
Loop

End Sub
 

Pièces jointes

  • Tri et sous total._2xlsm.xlsm
    20 KB · Affichages: 52

Discussions similaires

Réponses
6
Affichages
302

Statistiques des forums

Discussions
311 720
Messages
2 081 889
Membres
101 831
dernier inscrit
gillec