Ventilation Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
H
Hlawson
Jeune membre
Jeune membre
Messages : 29
Inscrit le : 9 avril 2019
Version d'Excel : 2016
Version de Calc : 16.0.4639.100

Message par Hlawson » 31 juillet 2019, 01:16

Bonsoir à tous les membres de Excel-Pratique de vba,

Je viens une fois de plus vers vous car je suis completement noyé

j ai essayé tant bien que mal de composer un formulaire , et je vois bien que le chemin est encore tres long avant d'arriver à quelque chose de serieux,
pourtant aujourd'hui j en ai vraiment besoin pour mon travail.

dans le fichier qui est joint, vous pourrez voir qu'il y a 5 feuilles: FEMME, HOMME,AGE_15-25, AGE_25-30 et SOURCE.
je voudrais avoir des donnes dans les feuilles correspondants :
copier les plages de donnees de la feuille SOURCE (FEMME) dans la Feuille FEMME...
copier les plages de donnees de la feuille SOURCE (HOMME) dans la Feuille HOMME...
et ensuite suivant une condition qui pourra copiée mes donnes dans ma SOURCE en tranche d'AGE et les collés dans ma feuille correspondante

je vous remercie de l'attention que vous porterez à mon souci qui pour moi devient insurmontable.

bonne soirée à tous
FORMULAIRE.xlsm
(18.32 Kio) Téléchargé 13 fois
g
gmb
Fanatique d'Excel
Fanatique d'Excel
Messages : 12'206
Appréciations reçues : 281
Inscrit le : 4 avril 2013
Version d'Excel : 2016

Message par gmb » 31 juillet 2019, 09:28

Bonjour

Un essai à tester. Te convient-il ,
Bye !
FORMULAIRE v1.xlsm
(34.84 Kio) Téléchargé 6 fois
1 membre du forum aime ce message.
Avatar du membre
Ausecour
Passionné d'Excel
Passionné d'Excel
Messages : 3'125
Appréciations reçues : 345
Inscrit le : 31 mai 2018
Version d'Excel : 2010 FR, 2013 FR

Message par Ausecour » 31 juillet 2019, 09:33

Bonjour,

je te retourne le fichier avec la macro à lancer manuellement, elle ventille bien tes données comme demandé, pour les tranches d'âge, j'ai fait selon moi, première: >=15 et <=25, deuxième: >25 et <=30.

Voici le résultat:
FORMULAIRE.xlsm
(25.1 Kio) Téléchargé 5 fois
Bonjour gmb (°v°)°
1 membre du forum aime ce message.
Plus un sujet a un titre précis, des explications claires, et un fichier Excel bien préparé, plus il a de chances d'avoir une réponse qui répond au besoin, mettez toutes les chances de votre côté :bien:
"100% des gagnants auront tenté leur chance" :trfl:
Avatar du membre
78chris
Passionné d'Excel
Passionné d'Excel
Messages : 4'121
Appréciations reçues : 299
Inscrit le : 9 juillet 2017
Version d'Excel : 2010 à 2019 + 365

Message par 78chris » 31 juillet 2019, 09:50

Bonjour à tous

Quitte à passer par un filtre j'aurais utilisé le filtre avancé plus optimisé que le filtre auto...

Je pense même que c'est plus rapide que les array

Une autre solution par PowerQuery puisque Hlawson a 2016.
Il suffit d'utiliser Données, Actualiser tout pour mettre à jour.

J'ai pris pour ma part
>=15 et <25
>=25 et <= 30

A noter qu'on a des personnes en dessous de 15 mais personne de 25 et plus dans l'exemple fourni
Ventilation_PQ.xlsm
(38.25 Kio) Téléchargé 1 fois
Chris
Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson.
Confucius
Avatar du membre
ThauThème
Passionné d'Excel
Passionné d'Excel
Messages : 3'363
Appréciations reçues : 115
Inscrit le : 19 octobre 2014
Version d'Excel : 2010 FR

Message par ThauThème » 31 juillet 2019, 09:54

Bonjour le fil, bonjour le forum,

J'arrive après la bagarre !... Comme j'ai commenté tout le code je me permets de proposer ma solution...
- J'ai commencé par supprimer l'espace à la fin du nom de l'onglet "AGE_25-30 " qui est devenu "AGE_25-30".
- Puis j'ai supprimé la ligne 1 de ce même onglet pour que les tableaux se situent tous au même niveau.
- J'ai aussi modifié les tranches d'âge car elles ne me paraissaient pas cohérentes 15/25 et 26/30 (à adapter)...

Le code :
Option Explicit

Sub Macro1()
Dim OS As Worksheet, OH As Worksheet, OF As Worksheet, O1 As Worksheet, O2 As Worksheet 'déclare les variables OS, OH, OF, O1 et O2 (onglets)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TLH() As Variant, TLF() As Variant, TL1() As Variant, TL2() As Variant 'déclare les variables TLH, TLF, TL1 et TL2 (Tableaux de Lignes)
Dim KH As Integer, KF As Integer, K1 As Integer, K2 As Integer 'déclare les variables KH, KF,K1 et K2 (incréments)
Dim L As Byte 'déclare la variable L (incrément)

Set OS = Worksheets("SOURCE") 'définit l'onglet OS (Onglet Source)
Set OH = Worksheets("HOMME") 'définit l'onglet OH (Onglet Homme)
Set OF = Worksheets("FEMME") 'définit l'onglet OF (Onglet Femme)
Set O1 = Worksheets("AGE_15-25") 'définit l'onglet O1 (Onglet 15-25)
Set O2 = Worksheets("AGE_25-30") 'définit l'onglet O2 (Onglet 25-30)
TV = OS.Range("A3").CurrentRegion 'définit la tableau des valeurs TV
OH.Range("A3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet OH
OF.Range("A3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet OF
O1.Range("A3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet O1
O2.Range("A3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet O2
KH = 1: KF = 1: K1 = 1: K2 = 1 'initialise les variables K
For I = 2 To UBound(TV, 1) 'boucle 1 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 2) = "M" Then 'condition 1 : si la donnée ligne I colonne 2 de TV est égale à "M"
        ReDim Preserve TLH(1 To UBound(TV, 2), 1 To KH) 'redimensionne le tableau des lignes homme TLH (autant de lignes de TV a de colonnes, KH colonnes)
        For L = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes L du tableau des valeurs TV)
            TLH(L, KH) = TV(I, L) 'récupère dans la ligne L de TLH la donnée en colonne L de TV (=> Transposition)
        Next L 'prochaine colonne de la boucle 2
        KH = KH + 1 'incrémente KH (ajoute une colonne au tableau des lignes homme TLH)
    End If 'fin de la condition 1
    If TV(I, 2) = "F" Then 'condition 1 : si la donnée ligne I colonne 2 de TV est égale à "F"
        ReDim Preserve TLF(1 To UBound(TV, 2), 1 To KF) 'redimensionne le tableau des lignes femme TLF (autant de lignes de TV a de colonnes, KF colonnes)
        For L = 1 To UBound(TV, 2) 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV)
            TLF(L, KF) = TV(I, L) 'récupère dans la ligne L de TLF la donnée en colonne L de TV (=> Transposition)
        Next L 'prochaine colonne de la boucle 3
        KF = KF + 1 'incrémente KF (ajoute une colonne au tableau des lignes femme TLF)
    End If 'fin de la condition 2
    If TV(I, 4) < 26 Then 'condition 3 : si la donnée ligne I colonne 4 de TV est inférieure à 26
        If TV(I, 4) <> "" Then 'condition 4 : si la donnée ligne I colonne 4 de TV n'est pas vide
            ReDim Preserve TL1(1 To UBound(TV, 2), 1 To K1) 'redimensionne le tableau des lignes 15-25 TL1 (autant de lignes de TV a de colonnes, K1 colonnes)
            For L = 1 To UBound(TV, 2) 'boucle 4 : sur toutes les colonnes L du tableau des valeurs TV)
                TL1(L, K1) = TV(I, L) 'récupère dans la ligne L de TL1 la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 4
            K1 = K1 + 1 'incrémente K1 (ajoute une colonne au tableau des lignes 15-25 TL1)
        End If 'fin de la condition 4
    Else 'sinon (condition3 => si la donné ligne I colonne 4 est supérieure ou égale à 26
        If TV(I, 4) <> "" Then 'condition 4 : si la donnée ligne I colonne 4 de TV n'est pas vide
            ReDim Preserve TL2(1 To UBound(TV, 2), 1 To K2) 'redimensionne le tableau des lignes 25-30 TL2 (autant de lignes de TV a de colonnes, K2 colonnes)
            For L = 1 To UBound(TV, 2) 'boucle 5 : sur toutes les colonnes L du tableau des valeurs TV)
                TL2(L, K2) = TV(I, L) 'récupère dans la ligne L de TL2 la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 5
            K2 = K2 + 1 'incrémente K2 (ajoute une colonne au tableau des lignes 25-30 TL2)
        End If 'fin de la condition 4
    End If 'fin de la condition 3
Next I 'prochaine ligne de la boucle 1
'si KH est supérieure à 1 renvoie dans A4 redimensionnée de l'onglet OH, le tableau TLH transposé
If KH > 1 Then OH.Range("A4").Resize(UBound(TLH, 2), UBound(TLH, 1)).Value = Application.Transpose(TLH)
'si KF est supérieure à 1 renvoie dans A4 redimensionnée de l'onglet OF, le tableau TLF transposé
If KF > 1 Then OF.Range("A4").Resize(UBound(TLF, 2), UBound(TLF, 1)).Value = Application.Transpose(TLF)
'si K1 est supérieure à 1 renvoie dans A4 redimensionnée de l'onglet O1, le tableau TL1 transposé
If K1 > 1 Then O1.Range("A4").Resize(UBound(TL1, 2), UBound(TL1, 1)).Value = Application.Transpose(TL1)
'si K2 est supérieure à 1 renvoie dans A4 redimensionnée de l'onglet O2, le tableau TL2 transposé
If K2 > 1 Then O2.Range("A4").Resize(UBound(TL2, 2), UBound(TL2, 1)).Value = Application.Transpose(TL2)
MsgBox "Données transférées !" 'message
End Sub
[Édition]
Je ne comprends pas pourquoi vous faites si simple alors qu'on peut faire si compliqué !... Honte à moi...

Le fichier :
HLawson_EP_v01.xlsm
(28.63 Kio) Téléchargé 3 fois
À plus,

ThauTheme


Je suis Charlie
VBA m'éclate, les formules m'ennuient ! Je n'y peux rien c'est comme ça...
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 15'500
Appréciations reçues : 551
Inscrit le : 27 août 2012
Version d'Excel : 365 Insider

Message par Jean-Eric » 31 juillet 2019, 10:39

Bonjour,
Une autre proposition Power Query.
Cdlt.
FORMULAIRE.xlsm
(44.64 Kio) Téléchargé 4 fois
1 membre du forum aime ce message.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
H
Hlawson
Jeune membre
Jeune membre
Messages : 29
Inscrit le : 9 avril 2019
Version d'Excel : 2016
Version de Calc : 16.0.4639.100

Message par Hlawson » 31 juillet 2019, 12:30

Mes remerciements a tous pour m'avoir donné la solution, je vous adore tous, vous tous formidable!
Avatar du membre
Ausecour
Passionné d'Excel
Passionné d'Excel
Messages : 3'125
Appréciations reçues : 345
Inscrit le : 31 mai 2018
Version d'Excel : 2010 FR, 2013 FR

Message par Ausecour » 31 juillet 2019, 13:02

De rien!
on s'est jetés dessus comme si on avait faim :lole:

Merci d'avoir passé le sujet en résolu :bien:
Plus un sujet a un titre précis, des explications claires, et un fichier Excel bien préparé, plus il a de chances d'avoir une réponse qui répond au besoin, mettez toutes les chances de votre côté :bien:
"100% des gagnants auront tenté leur chance" :trfl:
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message